Moved originally from StackOverflow, not knowing the existence of this sister site ...

Must say I find programming in Haskell to require much more cognitive intensity than any other language I've tried. I'm not certain I care about lazy evaluation or monads very much, but I do appreciate certain functional aspects, static type checking and not needing a huge VM to run.

I've been writing a short program to rename images based on EXIF and now have something that works. I'd like someone Haskell expert opinions on the overall structure of the source code in terms of what I've done right/wrong, and how I might improve and make the code more succinct. I won't bother posting the entire program but a lot of the overall structure is below.

import Control.Applicative
import Control.Monad.Error
import Data.Char
import Data.Either
import Data.List
import Data.Maybe
import Data.Time.Format
import Data.Time.LocalTime
import System.Console.GetOpt
import System.Directory
import System.Environment
import System.FilePath
import System.Locale
import System.IO.Error
import Text.Printf

import Album.Utils
import Album.Exif
import Album.Error

-- -----------------------------------------------------------------------
-- Main

main = do
  r <- try main0
  case r of
    Left err -> do
      printf "Error type:     %s\n" $ (show $ ioeGetErrorType err)
      printf "Error string:   %s\n" $ (ioeGetErrorString err)
      printf "Error filename: %s\n" $ (maybe "None" id $ ioeGetFileName err)
      printf "Error handle:   %s\n" $ (maybe "None" show $ ioeGetHandle err)
    Right _  -> return ()

-- Process arguments
main0 = do
  args <- getArgs
  case processArgs args desc of
    (True, _, usage) -> showUsage usage
    (False, (flags, fns, []), usage) -> do
      rv <- runErrorT $ main1 flags fns
      either (\e -> showErrs [show e] usage) (const $ return ()) rv
    (False, (_, _, errs), usage) -> showErrs errs usage
    desc = "Rename and catalog media.\n" ++
           "Usage: album -n <albumname> <options> <media files>\n"

-- Sanity check
main1 flags fns = do

    -- Check name
    albName <- maybe (throwError AlbumNameError) return $ albumName flags

    -- Check for duplicate media
    let dups = nub $ fns \\ nub fns
    unless (null dups) $ throwError $ MediaDuplicateError dups

    -- Check for valid filenames
    (haves, havenots) <- liftIO $ filesExist fns
    unless (null havenots) $ throwError $ MediaNotFoundError havenots
    when (null haves)      $ throwError MediaNotSpecifiedError

    -- Check exiftool existence
    tool0 <- liftIO $ findExecutable "exiftool"
    tool  <- maybe (throwError ExifToolNotFoundError) return tool0

    -- Get EXIF attributes
    exifs0 <- liftIO $ getExifs tool fns
    exifs  <- either (throwError . ExifParseError) return exifs0

    -- Check for exiftool errors
    let bads = findExifs "ExifTool:Error" exifs
    unless (null bads) $ throwError $ MediaBadError $ map fst bads

    -- Check for timestamps
    let infos0 = map (\(n,e) -> (n, exifToDateTime e)) exifs
    let nodates = filter (isNothing . snd) infos0
    unless (null nodates) $ throwError $ MediaDateTimeTagError $ map fst nodates

    let infos = map (\(n,Just dt) -> (n,dt)) infos0
    main2 albName infos

-- Do renames
main2 albName infos = do

    -- Album folder name
    let mints     = minimum $ map snd infos
    let mintsiso  = formatTime defaultTimeLocale "%Y%m%d" mints
    let albFolder = printf "%s - %s" mintsiso albName

    -- Get list of existing media
    albExist <- liftIO $ doesDirectoryExist albFolder
    (albCreate, existing) <- case albExist of
        False -> return (True, [])
        True -> do
            e <- liftIO $ filter ((/= ".") . nub) <$> getDirectoryContents albFolder
            return (False, e)

    -- Rename list
    let rens0 = mediaNames albName infos existing
    let rens1 = map (\(a,b) -> (a, combine albFolder b)) rens0
    let len = maximum $ map (length . fst) rens1

    if albCreate
      then do
        liftIO $ printf "Creating folder: %s\n" albFolder
        liftIO $ createDirectory albFolder
        return ()

    forM_ rens1 $ \(oldf, newf) -> do
        liftIO $ printf "%*s >>> %s\n" len oldf newf
        liftIO $ renameFile oldf newf

    return ()

showErrs errs usage = do
    putStrLn $ concatMap ("Error: " ++ ) errs
    return ()

showUsage usage = do
    putStrLn usage
    return ()

-- -----------------------------------------------------------------------
-- Rename

mediaNames albName infos existing = go existing (map cands infos)
    go es [] = []
    go es ((fn,cs):css) = let p = unused cs es in (fn,p):go (p:es) css
    unused cs es = fromJust $ find (`notElem` es) cs
    cands (fn,dt) = (fn, map (++ ext) (pref:alts))
        pref  = printf "%s - %s" (ft dt) albName
        ft dt = formatTime defaultTimeLocale "%Y%m%dT%H%M%S" dt
        alts  = map (printf "%s (%02d)" pref) ([1..] :: [Int])
        ext   = map toLower (takeExtension fn)

-- -----------------------------------------------------------------------
-- Arguments

data Option = OptionAlbumName String
            | OptionHelp
            deriving (Eq, Show)

processArgs args desc = (elem OptionHelp flags, opts, usage)
    opts@(flags, fns, errs)  = getOpt RequireOrder conf args
    usage = usageInfo desc conf
    conf  = [
      Option "n" ["name"] (ReqArg OptionAlbumName "NAME") "Album name",
      Option "h" ["help"] (NoArg OptionHelp) "Help"]

albumName (OptionAlbumName n:xs) = Just n
albumName (x:xs)                 = albumName xs
albumName []                     = Nothing
  • 2
    \$\begingroup\$ This may be a nitpick for a small program but it's a really good habit to give functions explicit type signatures. It's good documentation and it helps sanity check your mental model of the program against the compiler. \$\endgroup\$
    – asm
    Jul 8, 2011 at 13:45
  • \$\begingroup\$ Another suggestion: Even if you're only asking for feedback on key parts of the code (a good idea!) it would help if you uploaded the rest somewhere else, or at least enough of it so that people can load it into GHCi. \$\endgroup\$ Jul 15, 2011 at 21:59
  • \$\begingroup\$ You should start by renaming main0, main1 & main2... \$\endgroup\$ Jul 13, 2015 at 18:18

2 Answers 2


I'm definitely not a Haskell expert, but here are my 2 cents:

  • You should break your main functions in several methods. The amount of code running inside the IO monad should be minimized.
  • You often use case ... of where a separate function with pattern matching would be more readable
  • albumName could use a fold

At this place:

if albCreate
  then do
    liftIO $ printf "Creating folder: %s\n" albFolder
    liftIO $ createDirectory albFolder
    return ()

You could use the combinator when to make it a little bit shorter:

when albCreate $ do
  liftIO $ printf "Creating folder: %s\n" albFolder
  liftIO $ createDirectory albFolder 

You can also pull out the liftIO:

when albCreate . liftIO $ do
  printf "Creating folder: %s\n" albFolder
  createDirectory albFolder 

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.