diff --git a/Network/Delicious.hs b/Network/Delicious.hs --- a/Network/Delicious.hs +++ b/Network/Delicious.hs @@ -1,26 +1,26 @@ --------------------------------------------------------------------- --- | --- Module : Network.Delicious --- Copyright : (c) Sigbjorn Finne, 2008- --- License : BSD3 --- --- Maintainer: Sigbjorn Finne --- Stability : provisional --- Portability: --- --- Binding to del.icio.us tagging system --- - -module Network.Delicious - ( module Network.Delicious.Types - , module Network.Delicious.User - , module Network.Delicious.JSON - ) where - -import Network.Delicious.Types -import Network.Delicious.User --- default is JSON; selectively import the RSS one --- if you want to use it instead. -import Network.Delicious.JSON ---import Network.Delicious.RSS - +-------------------------------------------------------------------- +-- | +-- Module : Network.Delicious +-- Copyright : (c) Sigbjorn Finne, 2008- +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: +-- +-- Binding to del.icio.us tagging system +-- + +module Network.Delicious + ( module Network.Delicious.Types + , module Network.Delicious.User + , module Network.Delicious.JSON + ) where + +import Network.Delicious.Types +import Network.Delicious.User +-- default is JSON; selectively import the RSS one +-- if you want to use it instead. +import Network.Delicious.JSON +--import Network.Delicious.RSS + diff --git a/Network/Delicious/JSON.hs b/Network/Delicious/JSON.hs --- a/Network/Delicious/JSON.hs +++ b/Network/Delicious/JSON.hs @@ -16,7 +16,7 @@ -- variety of data for use in your own custom applications and -- browser-based presentation styles." -- -module Network.Delicious.JSON +module Network.Delicious.JSON ( getHotlist -- :: DM [Post] , getRecentBookmarks -- :: IO [Post] , getTagBookmarks -- :: Tag -> IO [Post] @@ -38,7 +38,7 @@ , getURLBookmarks -- :: URLString -> IO [Post] , getURLSummary -- :: URLString -> IO URLDetails , getURLDetails -- :: URLString -> IO URLDetails - + , HtmlFeed(..) , baseHtmlFeed -- :: HtmlFeed , feed_html_url @@ -55,16 +55,17 @@ import Control.Monad import Data.List import Data.Ord -import Data.Char import Data.Maybe - + +import Debug.Trace + import Network.Delicious.Fetch ( readContentsURL ) import Data.ByteString ( pack ) -import Data.Digest.OpenSSL.MD5 +import Data.Digest.OpenSSL.MD5 ------------------------------------------------------------------------ --- | Retrieve tags associated with a url from delicious. +-- | Retrieve tags associated with a url from delicious. -- An example, extract the tags associated with 'xmonad': -- -- > > getURLSummary "http://xmonad.org/" @@ -132,7 +133,7 @@ where eff_url = baseUrl ++ "/alerts" getUserBookmarks :: String -> DM [Post] -getUserBookmarks usr = handleResult "getUserBookmarks" eff_url +getUserBookmarks usr = trace (eff_url) $ handleResult "getUserBookmarks" eff_url where eff_url = baseUrl ++ '/':usr getUserTagBookmarks :: String -> Tag -> DM [Post] @@ -165,7 +166,7 @@ where eff_url = baseUrl ++ "/network/" ++ usr getNetworkMemberTaggedBookmarks :: String -> [Tag] -> DM [Post] -getNetworkMemberTaggedBookmarks usr tgs = +getNetworkMemberTaggedBookmarks usr tgs = handleResult "getNetworkMemberTaggedBookmarks" eff_url where eff_url = baseUrl ++ "/network/" ++ usr ++ '/':concat (intersperse "+" tgs) @@ -201,7 +202,7 @@ deriving (Eq,Show,Read) nullURLDetails :: URLDetails -nullURLDetails = +nullURLDetails = URLDetails { total = 0 , tags = [] , hash = "" @@ -226,7 +227,7 @@ Just (JSObject (JSONObject obj)) -> liftM (reverse . sortBy (comparing snd)) $ mapM (\(x,y) -> readJSON y >>= \y' -> return (x,y')) obj - Just x -> + Just x -> fail ("Network.Delicious.JSON: Unexpected JSON value for 'top_tags': " ++ show x) the_total <- case lookup "total_posts" pairs of @@ -278,7 +279,7 @@ , hf_extendedInDiv = Nothing , hf_extendedClass = Nothing } - + feed_html_url :: {-URL-}String feed_html_url = "http://feeds.delicious.com/html" @@ -310,13 +311,13 @@ , "extendeddiv" -==> fmap (\ x -> toB x "no" "yes") (hf_extendedInDiv hf) , "extendedclass" -==> hf_extendedClass hf ] - + consSlash "" = "" consSlash xs = '/':xs (-==>) _ Nothing = Nothing (-==>) a (Just b) = Just (a ++ '=':b) (-=>) a b = Just (a ++ '=':b) - + toB False a _ = a toB _ _ b = b diff --git a/Network/Delicious/RSS.hs b/Network/Delicious/RSS.hs --- a/Network/Delicious/RSS.hs +++ b/Network/Delicious/RSS.hs @@ -44,9 +44,8 @@ import Data.Maybe import Data.List ( intercalate ) -import Network.Curl import Data.ByteString ( pack ) -import Data.Digest.OpenSSL.MD5 +import Data.Digest.OpenSSL.MD5 -- ToDo: -- * support for 'count' parameter @@ -179,7 +178,7 @@ eff_url = network_url ++ u getNetworkMemberTaggedBookmarks :: String -> [Tag] -> DM [Post] -getNetworkMemberTaggedBookmarks u tgs = +getNetworkMemberTaggedBookmarks u tgs = performCall "getNetworkMemberTaggedBookmarks" eff_url where eff_url = network_url ++ u ++ '/':intercalate "+" tgs @@ -209,13 +208,13 @@ -} toPost :: Item -> Post -toPost i = +toPost i = nullPost { postHref = fromMaybe "" (getItemLink i) , postDesc = fromMaybe "" (getItemTitle i) , postUser = fromMaybe "" (getItemAuthor i) , postTags = getItemCategories i - , postStamp = fromMaybe "" (getItemPublishDate i) + , postStamp = fromMaybe "" (getItemPublishDateString i) } hashUrl :: URLString -> String diff --git a/Network/Delicious/Types.hs b/Network/Delicious/Types.hs --- a/Network/Delicious/Types.hs +++ b/Network/Delicious/Types.hs @@ -1,26 +1,26 @@ -------------------------------------------------------------------- -- | -- Module : Network.Delicious.Types --- Copyright : (c) Galois, Inc. 2008 +-- Copyright : (c) Sigbjorn Finne, 2008-2014 -- License : BSD3 -- --- Maintainer : Sigbjorn Finne +-- Maintainer : Sigbjorn Finne -- Stability : provisional -- Portability : portable -- -- Types and data structures used by the Delicious API binding. --- +-- -------------------------------------------------------------------- -module Network.Delicious.Types +module Network.Delicious.Types ( DateString , TimeString , URLString , User(..) , nullUser - + , DM , catchDM -- :: DM a -> (IOError -> DM a) -> DM a , withUser -- :: User -> DM a -> DM a @@ -34,26 +34,27 @@ , liftIO -- :: IO a -> DM a , runDelic -- :: User -> URLString -> DM a -> IO a , runDM -- :: User -> DM a -> IO a - + , Tag , TagInfo(..) , Bundle(..) , Filter(..) , nullFilter - + , Post(..) , nullPost - + ) where import Network.Curl.Types ( URLString ) import Data.Maybe ( catMaybes ) +import Control.Exception (catch) + import Text.JSON.Types import Text.JSON - type DateString = String type TimeString = String -- 8601 @@ -86,7 +87,7 @@ unDM (k v) env catchDM :: DM a -> (IOError -> DM a) -> DM a -catchDM (DM m) h = DM $ \ env -> catch (m env) (\err -> unDM (h err) env) +catchDM (DM m) h = DM $ \ env -> Control.Exception.catch (m env) (\err -> unDM (h err) env) withUser :: User -> DM a -> DM a withUser u k = DM $ \ env -> (unDM k) env{dmUser=u} @@ -125,7 +126,7 @@ runDM :: User -> DM a -> IO a runDM user a = runDelic user del_base a --- +-- type Tag = String diff --git a/Network/Delicious/User.hs b/Network/Delicious/User.hs --- a/Network/Delicious/User.hs +++ b/Network/Delicious/User.hs @@ -38,7 +38,6 @@ import Network.Delicious.Fetch -import Control.Monad import Data.List import Data.Maybe @@ -205,9 +204,9 @@ pl <- restReq "posts/delete" [("url", u)] case pl of Right x -> fail ("deletePost: ill-formed return value -- " ++ x) - Left d -> + Left d -> case qName $ elName d of - "result" + "result" | findAttr "code" "" d == "done" -> return () _ -> fail ("deletePost: unexpected return payload " ++ show d) @@ -221,7 +220,7 @@ "bundles" -> return (map eltToBundle $ findElements (unqual "bundle") d) _ -> fail ("getBundles: unexpected return payload " ++ show d) where - eltToBundle e = + eltToBundle e = Bundle { bundleName = findAttr "name" "" e , bundleTags = words $ findAttr "tag" "" e @@ -229,10 +228,10 @@ setBundle :: String -> [Tag] -> DM () setBundle nm tgs = do - pl <- restReq "tags/bundles/set" [("bundle",nm),("tags", unwords tgs)] + pl <- restReq "tags/bundles/set" [("bundle",nm),("tags", unwords tgs)] case pl of Right x -> fail ("setBundle: ill-formed return value -- " ++ x) - Left d -> + Left d -> case qName $ elName d of "result" | strContent d == "ok" -> return () _ -> fail ("setBundle: unexpected return value " ++ show d) @@ -242,7 +241,7 @@ pl <- restReq "tags/bundles/delete" [("bundle",nm)] case pl of Right x -> fail ("deleteBundle: ill-formed return value -- " ++ x) - Left d -> + Left d -> case qName $ elName d of "result" | strContent d == "done" -> return () _ -> fail ("deleteBundle: unexpected return value " ++ show d) diff --git a/delicious.cabal b/delicious.cabal --- a/delicious.cabal +++ b/delicious.cabal @@ -1,19 +1,25 @@ -name: delicious -version: 0.3.3 -homepage: http://galois.com -synopsis: Accessing the del.icio.us APIs from Haskell (v2) -description: Access to the del.icio.us social tagging site's API(v2) from Haskell -category: Web -license: BSD3 -license-file: LICENSE -author: Sigbjorn Finne -maintainer: Sigbjorn Finne -copyright: (c) 2008-2009 Sigbjorn Finne. -cabal-version: >= 1.2 -build-type: Simple +Name: delicious +Version: 0.3.4 +License: BSD3 +License-file: LICENSE +Category: Web +Synopsis: Accessing the del.icio.us APIs from Haskell (v2) +Description: + A Haskell binding to the del.icio.us API, letting you + programmatically access its tagged content. +Author: Sigbjorn Finne +Maintainer: Sigbjorn Finne +Homepage: https://github.com/sof/delicious +Copyright: (c) 2008-2014 Sigbjorn Finne. +Cabal-version: >= 1.8 +Build-type: Simple -library - exposed-modules: +Source-repository head + type: git + location: https://github.com/sof/delicious.git + +Library + Exposed-modules: Network.Delicious.Types, Network.Delicious.User, Network.Delicious.RSS, @@ -22,15 +28,15 @@ Network.Delicious - build-depends: base, + Build-depends: base >= 3 && < 5, xml >= 1.2.6, - feed >= 0.3.1, + feed >= 0.3.9.2, curl >= 1.1, bytestring, nano-md5, json >= 0.3.3 - ghc-options: -Wall + Ghc-options: -Wall -- Executable: dtest -- Main-is: Main.hs