bitly-cli-0.1: bitly.hs

module Main where

import Network.Bitly

import Control.Applicative ((<$>))
import Data.Char (isSpace)
import Data.Maybe (fromJust, fromMaybe, 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)
import Text.RegexPR

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

modifyUrl :: (String -> IO Result) -> String -> IO String
modifyUrl op url = do
  r <- op url
  case r of
    -- don't replace URL on error
    Left _ -> return url
    Right url' -> return url'

urlRE = "(http|ftp|https)://\\w+(\\.\\w+)+(:[0-9]+)?(/\\S+)?/?"

passThrough :: (String -> IO Result) -> String -> IO String
passThrough op txt =
  let m = matchRegexPR urlRE txt
  in case m of
    Nothing -> return txt
    Just ((url,(b,a)),_) -> do
      url' <- modifyUrl op url
      return . ((b ++ url') ++) =<< passThrough op a

-- process all given urls or read stdin and pass it through
runOp :: (String -> IO Result) -> [String] -> IO ()
runOp op [] = putStr =<< passThrough op =<< getContents
runOp op urls = mapM_ putStrLn =<< mapM (modifyUrl op) urls

usage = "Usage: bitly [ help | [shorten] [url ...] | expand [url ...] ]\n\n\
\If no url is given, bitly acts as a filter and replaces all found URLs.\n\
\Bitly shortens URLs by default.\n\n\
\Configuration file format (~/.bitly):\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) -> runOp (expand acc) urls
        ("shorten":urls) -> runOp (shorten acc) urls
        _  -> runOp (shorten acc) args -- shorten by default