isiz-0.0.1: src/isiz.hs

{-# OPTIONS -O -Wall #-}

import Control.Applicative ((<$>), (<*>), (<|>))
import Control.Monad (foldM, join)
import Data.List (find)
import Data.Maybe (catMaybes)
import System.Console.GetOpt
import System.Environment (getArgs)
import System.Exit (ExitCode (..), exitSuccess, exitWith)
import Text.Printf
import PixbufExtras

data RunMode = RunModeDefault
             | RunModeList Bool
             | RunModeSilent Bool
               deriving (Eq, Show)

data ImageSize = ZeroSized
               | Ratio4_3
               | Ratio5_4
               | Ratio16_9
               | Ratio16_10
               | Ratio21_9
               | NonStdHVGA
               | NonStdWVGA
               | NonStdWVGAPlus
               | NonStdFWVGA
               | NonStdWSVGA
               | NonStdWXGA
               | NonStdUnnamed
               | NonStdWSXGA
               | OtherSize
                 deriving (Eq, Show)

sizeName :: ImageSize -> String
sizeName ZeroSized      = "(zero-sized)"
sizeName Ratio4_3       = "4:3"
sizeName Ratio5_4       = "5:4"
sizeName Ratio16_9      = "16:9"
sizeName Ratio16_10     = "16:10"
sizeName Ratio21_9      = "21:9"
sizeName NonStdHVGA     = "HVGA"
sizeName NonStdWVGA     = "WVGA"
sizeName NonStdWVGAPlus = "WVGA+"
sizeName NonStdFWVGA    = "FWVGA"
sizeName NonStdWSVGA    = "WSVGA"
sizeName NonStdWXGA     = "WXGA"
sizeName NonStdUnnamed  = "(unnamed)"
sizeName NonStdWSXGA    = "WSXGA"
sizeName OtherSize      = "(other)"

nonStdSizes :: [(Int, Int, ImageSize)]
nonStdSizes = [ ( 480, 320, NonStdHVGA    )
              , ( 800, 480, NonStdWVGA    )
              , ( 854, 480, NonStdWVGAPlus)
              , ( 864, 480, NonStdFWVGA   )
              , (1024, 600, NonStdWSVGA   )
              , (1280, 768, NonStdWXGA    )
              , (1366, 768, NonStdUnnamed )
              , (1280, 854, NonStdWSXGA   ) ]

isWallpaper :: ImageSize -> Bool
isWallpaper ZeroSized      = False
isWallpaper OtherSize      = False
isWallpaper _              = True

checkSize :: Int -> Int -> Maybe ImageSize
checkSize w h
    | w <  h    = checkSize h w
    | h <  0    = Nothing
    | h == 0    = Just ZeroSized
    | otherwise =
        let ratio       = fromIntegral h / fromIntegral w
            minDelta    = 1e-2 :: Double
            testD s     = abs (ratio - s) < minDelta
            trd (_,_,c) = c
        in case () of
             _ | testD (3/ 4) -> Just Ratio4_3
             _ | testD (4/ 5) -> Just Ratio5_4
             _ | testD (9/16) -> Just Ratio16_9
             _ | testD (5/ 8) -> Just Ratio16_10
             _ | testD (3/ 7) -> Just Ratio21_9
             _                ->
                 (trd <$>
                  find (\(u, v, _) -> u == w && v == h)
                       nonStdSizes) <|> Just OtherSize

-- | read from file and return its size and whether suitable for wallpaper
checkFile :: FilePath -> IO (Maybe (ImageSize, Bool, Int, Int))
checkFile path = do
  mg <- pixbufGetSizeInfoFile path
  let ms = join $ uncurry checkSize <$> mg
      mp = isWallpaper <$> ms
  return $ (\(w, h) s p -> (s, p, w, h)) <$> mg <*> ms <*> mp

-- | flipped <$>
(<$$>) :: Functor m => m a -> (a -> b) -> m b
(<$$>) = flip fmap
infixl 5 <$$>

-- | perform action corresponding to RunMode on each file
checkFiles :: RunMode -> [FilePath] -> IO ()
checkFiles RunModeDefault paths =
    mapM_ (\path ->
           checkFile path >>=
           maybe (printf "%s: read error or not a image file\n" path)
                     (\(s, p, w, h) ->
                          printf "%s: %s, %s, %dx%d\n" path
                                 (if p then "wallpaper" else "not wallpaper")
                                 (sizeName s) w h)) paths
checkFiles (RunModeList v) paths =
    mapM (\path -> do
            res <- checkFile path
            return $ (\(_, p, _, _) ->
                          (path, if v then not p else p)) <$> res) paths
                   <$$> catMaybes
                   <$$> filter snd
                   >>= mapM_ (putStrLn . fst)
checkFiles (RunModeSilent v) paths =
    mapM (\path -> do
            res <- checkFile path
            return $ (\(_, p, _, _) ->
                          if v then not p else p) <$> res) paths
                   <$$> catMaybes
                   <$$> and
                   >>= \q -> if q then exitSuccess
                             else exitWith (ExitFailure 1)

data Opts = Help
          | Version
          | ListMode
          | SilentMode
          | InvPred

options :: [OptDescr Opts]
options = [ Option "h" ["help"]    (NoArg Help)
                       "Show help message and exit"
          , Option "V" ["version"] (NoArg Version)
                       "Show version info and exit"
          , Option "v" ["invert"]  (NoArg InvPred)
                       "Invert filtering condition for `-l' and `-q'"
          , Option "l" ["list"]    (NoArg ListMode)
                       "Just list files suitable for wallpapers"
          , Option "q" ["quiet"]   (NoArg SilentMode)
                       "Return successful status if all images suitable" ]

-- | parse commandline arguments
getOpts :: [String] -> IO (RunMode, [String])
getOpts argv =
    case getOpt Permute options argv of
      (o, n, []  ) -> foldOpts o <$$> toRunMode <$$> (\o' -> (o', n))
      (_, _, errs) -> ioError (userError $ concat errs)
    where foldOpts :: [Opts] -> IO (RunMode, Bool)
          foldOpts =
              foldM (\(m, v) e ->
                         case e of
                           Help       -> putStrLn usage
                                         >> exitSuccess
                                         >> return (m, v)
                           Version    -> putStrLn version
                                         >> exitSuccess
                                         >> return (m, v)
                           ListMode   -> return (RunModeList   False, v)
                           SilentMode -> return (RunModeSilent False, v)
                           InvPred    -> return (m, not v))
                        (RunModeDefault, False)
          toRunMode :: (RunMode, Bool) -> RunMode
          toRunMode (m, v) = case m of
                               RunModeDefault  -> RunModeDefault
                               RunModeList   _ -> RunModeList   v
                               RunModeSilent _ -> RunModeSilent v

usage :: String
usage = usageInfo "isiz [options] [files]\n\nOptions:" options

version :: String
version = "isiz version 0.0.1"

main :: IO ()
main = getArgs >>= getOpts >>= uncurry checkFiles