Bitly 0.0.1 → 0.0.2
raw patch · 3 files changed
+58/−24 lines, 3 filesdep +regexprPVP ok
version bump matches the API change (PVP)
Dependencies added: regexpr
API changes (from Hackage documentation)
Files
- Bitly.cabal +15/−8
- Network/Bitly.hs +13/−6
- bitly.hs +30/−10
Bitly.cabal view
@@ -1,5 +1,5 @@ Name: Bitly-Version: 0.0.1+Version: 0.0.2 Cabal-version: >= 1.2 Build-type: Simple @@ -17,16 +17,24 @@ . API key is required. Please find yours at <http://bit.ly/account/>. .- An optional command line utility is provided (use `-f buildCLI` to build it).+ Configuration file (`~/.bitly`) format:+ .+ > login = your_bit.ly_login+ > apikey = your_API_key+ .+ Examples (command line utility):+ .+ > $ echo "Text with an URL: http://example.com/" | bitly+ > Text with an URL: http://bit.ly/2eSq1z+ > $ bitly shorten http://example.com+ > http://bit.ly/2eSq1z+ > $ bitly expand http://bit.ly/2eSq1z+ > http://example.com/ Homepage: http://bitbucket.org/jetxee/hs-bitly/ Bug-reports: http://bitbucket.org/jetxee/hs-bitly/issues/ Tested-with: GHC == 6.10 -Flag buildCLI- Description: Build a command line tool to access bit.ly service.- Default: False- Library Build-depends: base >= 3 && < 5@@ -36,9 +44,8 @@ Executable bitly Main-is: bitly.hs- if !flag(buildCLI)- Buildable: False Build-depends: filepath , directory+ , regexpr
Network/Bitly.hs view
@@ -42,8 +42,15 @@ -> IO Result -- ^ Either error or long source URL expand acc url = request acc "expand" [("shortUrl", url)] [ "bitly", "results", code, "longUrl" ]- where code = reverse . takeWhile (/= '/') . reverse $ url -- ending of the URL+ where+ ending d = foldr (\x xs -> if d `elem` xs then xs else x:xs) ""+ code = dropHeadIf (== '/') $ ending '/' url +dropHeadIf :: (a -> Bool) -> [a] -> [a]+dropHeadIf _ [] = []+dropHeadIf p all@(x:xs)+ | p x = xs+ | otherwise = all -- | Internal function to accomodate all types of requests request :: Account -- ^ Account to use@@ -52,9 +59,9 @@ -> [String] -- ^ Path to the node with the result in the XML response -> IO Result request acc path params xmlpath = do- let baseURL = (server acc) ++ "/" ++ path+ let baseURL = server acc ++ "/" ++ path let params' = loginParams ++ params :: [ (String, String) ]- let reqURL = baseURL ++ "?" ++ (urlEncodeVars params')+ let reqURL = baseURL ++ "?" ++ urlEncodeVars params' let req = getRequest reqURL :: Request String resp <- simpleHTTP req case resp of@@ -78,15 +85,15 @@ let cs = tag "bitly" /> tag "statusCode" /> txt $ root case cs of [] -> Left "No statusCode in response"- (CString _ code:_) -> do- if (code /= "OK")+ (CString _ code:_) ->+ if code /= "OK" then let err = concatMap (render . content) $ tag "bitly" /> tag "errorMessage" /> txt $ root in Left $ "Bit.ly error: " ++ err else let url' = concatMap (render . content) $- (foldr (/>) txt $ map tag xmlpath ) $ root+ foldr (/>) txt (map tag xmlpath) root in if null url' then Left "Result not found" else Right url'
bitly.hs view
@@ -4,12 +4,13 @@ import Control.Applicative ((<$>)) import Data.Char (isSpace)-import Data.Maybe (fromJust, isJust, isNothing)+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@@ -32,15 +33,34 @@ errorExit s = hPutStrLn stderr s >> exitFailure -printModifiedUrl :: (String -> IO Result) -> String -> IO ()-printModifiedUrl op url = do+modifyUrl :: (String -> IO Result) -> String -> IO String+modifyUrl op url = do r <- op url case r of- Left err -> errorExit err- Right url' -> putStrLn url'+ -- don't replace URL on error+ Left _ -> return url+ Right url' -> return url' -usage = "Usage: bitly ( help | [shorten] [url ...] | expand [url ...] )\n\n\-\Configuration file format:\n\+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" @@ -57,7 +77,7 @@ 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+ ("expand":urls) -> runOp (expand acc) urls+ ("shorten":urls) -> runOp (shorten acc) urls+ _ -> runOp (shorten acc) args -- shorten by default