Bitly-0.0.1: bitly.hs

module Main where

import Network.Bitly

import Control.Applicative ((<$>))
import Data.Char (isSpace)
import Data.Maybe (fromJust, isJust, isNothing)
import System.Directory (getHomeDirectory)
import System.Environment (getArgs)
import System.Exit (exitFailure, exitSuccess)
import System.FilePath (makeValid, combine)
import System.IO (hPutStrLn, stderr)

confFileName :: IO String
confFileName = makeValid <$> flip combine ".bitly" <$> getHomeDirectory

readConfig :: IO (Maybe Account)
readConfig = do
  file <- confFileName
  conf <- map (brk '=') . lines <$> readFile file `catch` (\_ -> return "")
  let l = lookup "login" conf
  let k = lookup "apikey" conf
  if isJust l && isJust k
    then return $ Just bitlyAccount { login = fromJust l, apikey = fromJust k }
    else return Nothing

brk d str =
  let (a,b) = break (== d) str
  in  (trim a, trim . dropWhile (== d) $ b)

trim = dropWhile isSpace . reverse . dropWhile isSpace . reverse

errorExit s = hPutStrLn stderr s >> exitFailure

printModifiedUrl :: (String -> IO Result) -> String -> IO ()
printModifiedUrl op url = do
  r <- op url
  case r of
    Left err -> errorExit err
    Right url' -> putStrLn url'

usage = "Usage: bitly ( help | [shorten] [url ...] | expand [url ...] )\n\n\
\Configuration file format:\n\
\  login = your_bit.ly_login\n\
\  apikey = your_API_key"

main = do
  args <- getArgs
  if "help" `elem` args || "--help" `elem` args
    then putStrLn usage >> exitSuccess
    else do

  conf <- readConfig
  case conf of
    Nothing -> do
      f <- confFileName
      errorExit $ "Configuration file is incomplete or not found (" ++ f ++ ")"
    Just acc ->
      case args of
        ("expand":urls) -> printModifiedUrl (expand acc) `mapM_` urls
        ("shorten":urls) -> printModifiedUrl (shorten acc) `mapM_` urls
        _  -> printModifiedUrl (shorten acc) `mapM_` args -- shorten by default