import Control.Monad
import Control.Monad.Error
import Data.Enumerator.IO
import Data.Maybe
import Data.Time.Clock ( getCurrentTime )
import Data.Time.Format ( formatTime )
import Data.Time.LocalTime ( utcToLocalZonedTime )
import Network.HTTP.Enumerator hiding ( path )
import System.Cmd
import System.Directory
import System.Environment
import System.Exit
import System.IO
import System.Locale ( defaultTimeLocale )
import Text.Printf
import Text.Regex


outputProgInfo :: IO ()
outputProgInfo = do
   dateStamp <- fmap
      (formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S %Z")
      $ getCurrentTime >>= utcToLocalZonedTime
   putStrLn dateStamp

   progName <- getProgName
   putStrLn $ progName ++
      "  v2.0.3.0  Dino Morelli <dino@ui3.info>"
   putStrLn "http://ui3.info/darcs/fa-cbr\n"


data EP = EP String (IO ExitCode)

instance Error EP where
   strMsg msg = EP msg $ return ExitSuccess


getEpisode :: [String] -> ErrorT EP IO String

getEpisode (e:_) = do
   return $ printf "%04d" $ (read e :: Int)

getEpisode _     = do
   files <- liftIO $ getDirectoryContents "."
   let re = mkRegex "([0-9]+)"
   let nss = map head . catMaybes .
         map (matchRegex re) $ files
   let m = foldl max (-1) . map read $ nss :: Int

   when (m < 0) $ throwError $
      EP "Unable to determine next issue number"
         (return $ ExitFailure 1)

   return $ printf "%04d" (m + 1)


checkFileExists :: FilePath -> ErrorT EP IO ()
checkFileExists cbtFile = do
   exists <- liftIO $ doesFileExist cbtFile
   when exists $ throwError $ EP (printf "CBR file %s already exists. Aborting!" cbtFile)
      (return $ ExitFailure 2)


cleanUp :: MonadIO m => FilePath -> m ()
cleanUp dirPath = liftIO $ do
   putStrLn "Cleaning up.."
   removeDirectoryRecursive dirPath


makePathUrl :: String -> Int -> (String, String)
makePathUrl episode page = (path, url)
   where
      path = printf "FA%s-%d.jpg" episode page
      url = printf "http://www.freakangels.com/comics/%s" path


{- Download a file using a URL and store it on disk locally in constant 
   memory. The boolean result is whether or not the file was present
   that we asked for. This server in particular wants to redirect to
   an index page with a 302 if the URL is bad.
-}
downloadFile :: FilePath -> String -> IO Bool
downloadFile path url = liftIO $ withFile path WriteMode $ \handle -> do
   request <- parseUrl url
   http (\code _ -> iterHandle handle >> return (code == 200)) request


downloadFiles :: String -> FilePath -> ErrorT EP IO ()
downloadFiles episode dirPath = do
   cwd <- liftIO $ do
      putStrLn "Creating dir for downloaded images.."
      createDirectory dirPath
      getCurrentDirectory  -- Save this path for later

   -- Try first image to check if this is a valid issue
   dlSucceeded <- liftIO $ do
      setCurrentDirectory dirPath
      putStrLn "Downloading images.."
      let (path, url) = makePathUrl episode 1
      ds <- downloadFile path url
      setCurrentDirectory cwd
      return ds

   -- It's not a valid issue, stop now
   unless dlSucceeded $ throwError $ EP (printf "Pages for episode %s were not found. Is this a valid episode number?" episode)
      (cleanUp dirPath >> (return $ ExitFailure 3))

   -- We're good, get the rest of the pages
   liftIO $ do
      setCurrentDirectory dirPath
      forM_ [2..6] $ \n -> do
         let (path, url) = makePathUrl episode n
         downloadFile path url
      setCurrentDirectory cwd


constructCbr :: FilePath -> FilePath -> ErrorT EP IO ()
constructCbr cbtFile dirPath = do
   liftIO $ putStrLn "Constructing CBR file.."
   _ <- liftIO $ system $ printf "tar cvf %s %s" cbtFile dirPath

   cleanUp dirPath

   liftIO $ putStrLn $ printf "Complete. Your new file: %s" cbtFile


main :: IO ()
main = do
   hSetBuffering stdout NoBuffering

   outputProgInfo

   result <- runErrorT $ do
      episode <- liftIO getArgs >>= getEpisode

      let dirPath = printf "FreakAngels_%s" episode
      let cbtFile = dirPath ++ ".cbt"

      checkFileExists cbtFile

      downloadFiles episode dirPath

      constructCbr cbtFile dirPath

      return ExitSuccess

   either (\(EP msg a) -> do
      putStrLn $ "ERROR: " ++ msg
      exitWith =<< a
      )
      exitWith result