Sergey Astanin avatar Sergey Astanin committed 6c72345

Split into two packages: Bitly library and bitly-cli command-line tool.

Comments (0)

Files changed (14)

Bitly.cabal

-Name:          Bitly
-Version:       0.0.6
-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/>.
-  .
-  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, GHC == 6.12.1
-
-Library
-  Build-depends:
-                 base >= 3 && < 5
-               , HTTP >= 4000
-               , HaXml >= 1.20 && < 1.21
-  Exposed-modules: Network.Bitly
-
-Executable bitly
-  Main-is:     bitly.hs
-  Build-depends:
-                 filepath >= 1.1
-               , directory >= 1.0 && < 1.1
-               , regexpr >= 0.5
-

LICENSE

-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

--- | 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.Util (docContent)
-import Text.XML.HaXml.Posn (noPos, Posn)
-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
-    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
-        -> 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 doc = xmlParse "" . rspBody $ resp'
-      return $ errorOrResult doc xmlpath
-  where
-    loginParams =
-             [ ("login", login acc)
-             , ("apiKey", apikey acc)
-             , ("format", "xml")
-             , ("version", "2.0.1")
-             ]
-
--- | Analyze XML response
-errorOrResult :: Document Posn -- ^ Parsed XML document
-              -> [String]   -- ^ Path to the node with the result
-              -> Result
-errorOrResult rootelement xmlpath = do
-  let root = docContent noPos rootelement
-  let cs = tag "bitly" /> tag "statusCode" /> txt $ root
-  case cs of
-    [] -> Left "No statusCode in response"
-    ((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
-              in  if null url'
-                    then Left "Result not found"
-                    else Right url'
-    _  -> Left "Unexpected statusCode in response"
-

Setup.lhs

-#!/usr/bin/env runhaskell
-> import Distribution.Simple
-> main = defaultMain

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
-
+Copyright (c) 2009-2011, 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.
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
+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
+
+#!/bin/bash
+
+ghc --make bitly.hs && \
+[ `./bitly expand $(./bitly http://example.com/)` = "http://example.com/" ] && echo OK || echo FAIL
+rm ./bitly ./bitly.{hi,o}
+Name:          Bitly
+Version:       0.0.6
+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 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/>.
+  .
+  Configuration file (`~/.bitly`) format:
+  .
+  > login = your_bit.ly_login
+  > apikey = your_API_key
+  .
+  For command line utility see `bitly-cli` package.
+
+Homepage:      http://bitbucket.org/jetxee/hs-bitly/
+Bug-reports:   http://bitbucket.org/jetxee/hs-bitly/issues/
+Tested-with:   GHC == 6.10, GHC == 6.12.1
+
+Library
+  Build-depends:
+                 base >= 3 && < 5
+               , HTTP >= 4000
+               , HaXml >= 1.20 && < 1.21
+  Exposed-modules: Network.Bitly
+Copyright (c) 2009-2011, 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.

lib/Network/Bitly.hs

+-- | 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.Util (docContent)
+import Text.XML.HaXml.Posn (noPos, Posn)
+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
+    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
+        -> 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 doc = xmlParse "" . rspBody $ resp'
+      return $ errorOrResult doc xmlpath
+  where
+    loginParams =
+             [ ("login", login acc)
+             , ("apiKey", apikey acc)
+             , ("format", "xml")
+             , ("version", "2.0.1")
+             ]
+
+-- | Analyze XML response
+errorOrResult :: Document Posn -- ^ Parsed XML document
+              -> [String]   -- ^ Path to the node with the result
+              -> Result
+errorOrResult rootelement xmlpath = do
+  let root = docContent noPos rootelement
+  let cs = tag "bitly" /> tag "statusCode" /> txt $ root
+  case cs of
+    [] -> Left "No statusCode in response"
+    ((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
+              in  if null url'
+                    then Left "Result not found"
+                    else Right url'
+    _  -> Left "Unexpected statusCode in response"
+
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain

test.sh

-#!/bin/bash
-
-[ `./bitly expand $(./bitly http://example.com/)` = "http://example.com/" ] && echo OK || echo FAIL
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.