Bitly (empty) → 0.0.1
raw patch · 5 files changed
+229/−0 lines, 5 filesdep +HTTPdep +HaXmldep +basesetup-changed
Dependencies added: HTTP, HaXml, base, directory, filepath
Files
- Bitly.cabal +44/−0
- LICENSE +25/−0
- Network/Bitly.hs +94/−0
- Setup.lhs +3/−0
- bitly.hs +63/−0
+ Bitly.cabal view
@@ -0,0 +1,44 @@+Name: Bitly+Version: 0.0.1+Cabal-version: >= 1.2+Build-type: Simple++Stability: experimental+Category: Web+License: BSD3+License-file: LICENSE+Maintainer: Sergey Astanin <s.astanin@gmail.com>++Synopsis: A library and a command line tool to access bit.ly URL shortener.+Description:+ This package allows to use bit.ly and j.mp URL+ shortening service from Haskell. Currently it supports+ shorten and expand requests.+ .+ 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).++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+ , HTTP >= 4000+ , HaXml+ Exposed-modules: Network.Bitly++Executable bitly+ Main-is: bitly.hs+ if !flag(buildCLI)+ Buildable: False+ Build-depends:+ filepath+ , directory+
+ LICENSE view
@@ -0,0 +1,25 @@+Copyright (c) 2009, Sergey Astanin+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.+ * Neither the name of the Sergey Astanin nor the names of other+ contributors may be used to endorse or promote products derived from this+ software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Network/Bitly.hs view
@@ -0,0 +1,94 @@+-- | This package allows to use @bit.ly@ and @j.mp@ URL shortening service+-- from Haskell programs. See also "Network.TinyURL" module.++module Network.Bitly+ (Account(..), bitlyAccount, jmpAccount, shorten, expand, Result)+where++import Network.HTTP+import Text.XML.HaXml+import Text.XML.HaXml.Pretty (element, content)++-- | Service credentials.+data Account = Account+ { login :: String, -- ^ bit.ly login name+ apikey :: String, -- ^ API key as found at <http://bit.ly/account/>+ server :: String -- ^ Server to use, e.g. @http:\/\/api.j.mp@+ } deriving (Read, Show)++-- | Account to use with bit.ly+bitlyAccount :: Account+bitlyAccount = Account+ { login = "", apikey = "", server = "http://api.bit.ly" }++-- | Account to use with j.mp+jmpAccount :: Account+jmpAccount = Account+ { login = "", apikey = "", server = "http://api.j.mp" }++-- | Either an error message or a modified URL+type Result = Either String String++-- | Given a long URL, @shorten@ encodes it as a shorter one.+shorten :: Account -- ^ Account to use+ -> String -- ^ Long URL+ -> IO Result -- ^ Either error or short bit.ly URL+shorten acc url = request acc "shorten" [("longUrl", url)]+ [ "bitly", "results", "nodeKeyVal", "shortUrl" ]++-- | Given a short bit.ly URL, @expand@ decodes it back into a long source URL.+expand :: Account -- ^ Account to use+ -> String -- ^ Short bit.ly URL+ -> 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+++-- | Internal function to accomodate all types of requests+request :: Account -- ^ Account to use+ -> String -- ^ Name of the API request (e.g. @shorten@ or @expand@)+ -> [(String,String)] -- ^ Alist of the parameters specific to the request+ -> [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 params' = loginParams ++ params :: [ (String, String) ]+ let reqURL = baseURL ++ "?" ++ (urlEncodeVars params')+ let req = getRequest reqURL :: Request String+ resp <- simpleHTTP req+ case resp of+ Left _ -> return $ Left "Network error"+ Right resp' -> do+ let Document _ _ xmlroot _ = xmlParse "" . rspBody $ resp'+ return $ errorOrResult (CElem xmlroot) xmlpath+ where+ loginParams =+ [ ("login", login acc)+ , ("apiKey", apikey acc)+ , ("format", "xml")+ , ("version", "2.0.1")+ ]++-- | Analyze XML response+errorOrResult :: Content -- ^ XML root element+ -> [String] -- ^ Path to the node with the result+ -> Result+errorOrResult root xmlpath = do+ let cs = tag "bitly" /> tag "statusCode" /> txt $ root+ case cs of+ [] -> Left "No statusCode in response"+ (CString _ code:_) -> do+ 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+ in if null url'+ then Left "Result not found"+ else Right url'+ _ -> Left "Unexpected statusCode in response"+
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ bitly.hs view
@@ -0,0 +1,63 @@+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+