hunp-0.0: Hunp.hs

{-# LANGUAGE OverloadedStrings #-}

-- Copyright (c) 2009 Deniz Dogan

module Main where

import Control.Monad
import Data.List
import Data.Maybe
import System.Directory
import System.Environment
import System.Exit
import System.FilePath.Posix
import System.IO
import System.Process
import Text.Regex.PCRE.Light
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
  args <- getArgs
  if null args
    then usage
    else mapM_ hunp args

usage :: IO ()
usage = let ls = ["Usage:",
                  "  hunp <files/directories>"]
        in putErrLn (unlines ls)

-- | Given a FilePath, determines whether it is pointing to a file or
--   a directory and takes the appropriate action.
hunp :: FilePath -> IO ()
hunp fp = do
  isFile <- doesFileExist fp
  isDir <- doesDirectoryExist fp
  when isFile (hunpFile fp)
  when isDir (hunpDir fp)
  when (not $ isFile || isDir) (putErrLn $ "Could not find " ++ fp ++ ". Skipping.")

hunpFile :: FilePath -> IO ()
hunpFile fp = do
  let res = lookupWith (any (\x -> match' x (B.pack fp) [])) fileTypes
  case res of
    Nothing -> putErrLn $ "What am I supposed to do with this file?"
    Just (cmd, args) -> do
      unpack cmd (map (replaceIt fp) $ words args) >>=
       waitForProcess >>=
       \x -> putStrLn $ case x of
               ExitSuccess -> "Successfully unpacked `" ++ takeFileName fp ++ "'."
               _           -> "Something went wrong with `" ++ takeFileName fp ++ "'."

-- | Hackish way of performing printf substitution.  This was needed
--   for some silly reason that I can't be bothered remembering.
replaceIt :: String -> String -> String
replaceIt fp "%s" = fp
replaceIt _  x    = x

-- | Given a directory path, looks for the first file in the directory
--   matching any of the file regexp rules.  If it finds any file
--   matching any rule, it stops and unpacks the first found file.  It
--   will never unpack several files in a directory.
hunpDir :: FilePath -> IO ()
hunpDir fp = do
  cont <- getDirectoryContents fp
  case find (\f -> isJust $ lookupWith (any (\x -> match' x (B.pack f) [])) fileTypes) cont of
    Just x -> hunpFile (fp </> x)
    Nothing -> putErrLn $ "Found nothing to unpack in " ++ fp

-- | Exactly like 'Text.Regex.PCRE.Light', but returns @True@ if there
--   was a match, otherwise @False@.
match' :: Regex -> B.ByteString -> [PCREExecOption] -> Bool
match' a b c = isJust $ match a b c

-- | Generalization of 'lookup'.
lookupWith :: (a -> Bool) -> [(a, b)] -> Maybe b
lookupWith _ []          = Nothing
lookupWith p ((x, y):xs) | p x = Just y
                         | otherwise = lookupWith p xs

unpack :: String -> [String] -> IO ProcessHandle
unpack cmd args = runProcess cmd args Nothing Nothing Nothing Nothing Nothing

putErrLn :: String -> IO ()
putErrLn = hPutStrLn stderr

fileTypes :: [([Regex], (String, String))]
fileTypes = let compileRegexen (xs, y) = (map (flip compile []) xs, y)
                ls = [ (["\\.rar$", "\\.r00$"], ("unrar", "x %s"))
                     , (["\\.tar\\.gz$", "\\.tgz$"], ("tar", "-zxvf %s"))
                     , (["\\.tar\\.bz2$"], ("tar", "-jxvf %s"))
                     , (["\\.bz2$"], ("bunzip2", "%s"))
                     , (["\\.zip$"], ("unzip", "%s"))
                     , (["\\.arj$"], ("unarj", "x %s"))
                     , (["\\.7z$"], ("7z", "x %s"))
                     , (["\\.ace$"], ("unace", "x %s"))
                     ]
            in map compileRegexen ls