Commits

Sebastián Magrí committed ffabc35

Reduce redundancy and data types non sense. Improve option handling.

Comments (0)

Files changed (3)

 description: A client and library for SoundCloud.com written in Haskell
 executable hscd
            build-depends: aeson
-                        , attoparsec
                         , base
                         , bytestring
                         , ghc-prim
                         , HTTP
-                        , network
-                        , text
            main-is: hscd.hs
            hs-source-dirs: src/
            ghc-options: -W -Wall

src/Network/SoundCloud.hs

 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
 
 {-
   Implementing the SoundCloud API
 module Network.SoundCloud where
 
 import Data.Aeson
-import qualified Data.ByteString.Lazy.Char8 as StrLazy
-import qualified Data.Text as Txt
+import qualified Data.ByteString.Lazy.Char8 as BSL
 import GHC.Generics (Generic)
 import Network.HTTP
 import System.IO
 
 
-data ScUser = ScUser {
-    userId               :: Int
-  , userPermalink        :: Txt.Text
-  , userName             :: Txt.Text
-  , userUri              :: Txt.Text
-  , userPermalinkUrl     :: Txt.Text
-  , userAvatarUrl        :: Txt.Text
-  } deriving (Show, Generic)
-
-data ScTrack = ScTrack { id                       :: Int
-                       , user_id                  :: Int
-                       , original_content_size :: Int
-                       , downloadable        :: Bool
-                       , title               :: Txt.Text
-                       , original_format      :: Txt.Text
-                       , download_url          :: Txt.Text
+data ScJSON = ScJSON { id                       :: Int
+                       , user_id                :: Int
+                       , original_content_size  :: Int
+                       , downloadable           :: Bool
+                       , title                  :: String
+                       , original_format        :: String
+                       , download_url           :: String
                        } deriving (Show, Generic)
 
-instance FromJSON ScUser
-instance ToJSON   ScUser
-instance FromJSON ScTrack
-instance ToJSON   ScTrack
+instance FromJSON ScJSON
+instance ToJSON   ScJSON
 
 
-clientId :: Txt.Text
+clientId :: String
 clientId = "934a79db328a60a0ea459ab9e45c1735"
 
-apiURL :: Txt.Text
+apiURL :: String
 apiURL = "http://api.soundcloud.com"
 
-apiURLS :: Txt.Text
+apiURLS :: String
 apiURLS = "https://api.soundcloud.com"
 
-apiMeURLS :: Txt.Text
-apiMeURLS = Txt.append apiURLS "/me"
+apiMeURLS :: String
+apiMeURLS = apiURLS ++ "/me"
 
-authURLS :: Txt.Text
+authURLS :: String
 authURLS = "https://soundcloud.com/connect"
 
-tokenURLS :: Txt.Text
-tokenURLS = Txt.append apiURLS "/oauth2/token"
+tokenURLS :: String
+tokenURLS = apiURLS ++ "/oauth2/token"
 
-tracksURL :: Txt.Text
-tracksURL = Txt.append apiURL "/tracks"
+tracksURL :: String
+tracksURL = apiURL ++ "/tracks"
 
-usersURL :: Txt.Text
-usersURL = Txt.append apiURL "/users"
+usersURL :: String
+usersURL = apiURL ++ "/users"
 
-playlistsURL :: Txt.Text
-playlistsURL = Txt.append apiURL "/playlists"
+playlistsURL :: String
+playlistsURL = apiURL ++ "/playlists"
 
-groupsURL :: Txt.Text
-groupsURL = Txt.append apiURL "/groups"
+groupsURL :: String
+groupsURL = apiURL ++ "/groups"
 
-commentsURL :: Txt.Text
-commentsURL = Txt.append apiURL "/comments"
+commentsURL :: String
+commentsURL = apiURL ++ "/comments"
 
-meURLS :: Txt.Text
-meURLS = apiMeURLS
+meConnectionsURLS :: String
+meConnectionsURLS = apiMeURLS ++ "/connections"
 
-meConnectionsURLS :: Txt.Text
-meConnectionsURLS = Txt.append apiMeURLS "/connections"
+meActivitiesURLS :: String
+meActivitiesURLS = apiMeURLS ++ "/activities"
 
-meActivitiesURLS :: Txt.Text
-meActivitiesURLS = Txt.append apiMeURLS "/activities"
+appsURLS :: String
+appsURLS = apiURL ++ "/apps"
 
-appsURLS :: Txt.Text
-appsURLS = Txt.append apiURL "/apps"
+resolveURL :: String
+resolveURL = apiURL ++ "/resolve"
 
-resolveURL :: Txt.Text
-resolveURL = Txt.append apiURL "/resolve"
-
-scDownload :: Txt.Text -> IO (Maybe StrLazy.ByteString)
-scDownload url =
-    do res <- simpleHTTP $ getRequest $ Txt.unpack url
+scGet :: String -> Bool -> IO (Maybe String)
+scGet url followRedirections =
+    do res <- simpleHTTP $ getRequest url
        case res of
-         Left _ -> return Nothing
-         Right r ->
+         Left   _ -> return Nothing
+         Right  r ->
              case rspCode r of
-               (2,_,_) -> return $ Just $ StrLazy.pack $ rspBody r
+               (2,_,_) -> return $ Just $ rspBody r
                (3,_,_) ->
                    case findHeader HdrLocation r of
-                     Nothing -> return Nothing
-                     Just uri -> scDownload (Txt.pack uri)
+                     Nothing       -> return Nothing
+                     Just uri      ->
+                         if followRedirections
+                         then scGet uri True
+                         else return $ Just uri
                _ -> return Nothing
 
-getJSONText :: Txt.Text -> IO (StrLazy.ByteString)
-getJSONText url = 
-    do result <- scDownload url
+scGetJSON :: String -> IO String
+scGetJSON url =
+    do result <- scGet url False
        case result of
          Nothing    -> return "{}"
          Just     r -> return r
 
+scFetch :: String -> String -> IO ()
+scFetch dUrl out =
+    do contents <- scGet dUrl True
+       case contents of
+         Nothing -> putStrLn "Could not fetch file contents."
+         Just  c ->
+             do file <- openBinaryFile out WriteMode
+                hPutStr file c
+                hClose file
 
-scResolve :: [Char] -> IO ()
+
+scFetchTrack :: String -> String -> IO ()
+scFetchTrack trackUrl output =
+    do tUrl <- scResolve trackUrl
+       dat <- scGetJSON tUrl
+       let o = decode (BSL.pack dat) :: Maybe ScJSON
+       case o of
+         Nothing        -> putStrLn "Unable to get track information."
+         Just obj       ->
+             if downloadable obj then
+                 do let dUrlStr = concat [download_url obj, "?client_id=", clientId]
+                    let filename = if null output then "./" ++ title obj ++ "." ++ original_format obj else output
+                    putStrLn $ "Fetching " ++ show (original_content_size obj) ++ " bytes"
+                    scFetch dUrlStr filename
+             else putStrLn "Track is not downloadable"
+
+
+{-
+This function's request will always return a (3,_,_) status,
+so we can return the redirection Location
+-}
+scResolve :: String -> IO String
 scResolve url =
-    do dat <- getJSONText resolveUrl
-       let o = decode dat :: Maybe ScTrack
-       case o of
-         Nothing  -> StrLazy.putStrLn "Couldn't get anything from response"
-         Just obj ->
-             case downloadable obj of
-               True ->
-                   do let dUrlStr = Txt.concat [download_url obj, "?client_id=", clientId]
-                      let filename = "./" ++ Txt.unpack (title obj) ++ "." ++ Txt.unpack (original_format obj)
-                      StrLazy.putStrLn $ StrLazy.pack ("Fetching to: " ++ filename)
-                      contents <- scDownload dUrlStr
-                      case contents of
-                        Nothing -> StrLazy.putStrLn "Could not fetch file contents"
-                        Just  c ->
-                            do file <- openBinaryFile filename WriteMode
-                               hPutStr file (StrLazy.unpack c)
-                               hClose file
-               False -> StrLazy.putStrLn "Track is not downloadable"
+    do dat <- scGet resolveUrl False
+       case dat of
+         Nothing        -> return ""
+         Just d         -> return d
     where
-        txtUrl = Txt.pack url
-        resolveUrl = Txt.concat [resolveURL, ".json?url=", txtUrl, "&client_id=", clientId]
+        resolveUrl = concat [resolveURL, ".json?url=", url, "&client_id=", clientId]
 
 
 import Network.SoundCloud
 
-data Options = Options { optURL :: IO String
-                       , optOutput :: String -> IO ()}
+data Options = Options { optTrackURL    :: Maybe String
+                       , optResolve     :: Maybe String
+                       , optOutput      :: Maybe String
+                       }
 options :: [OptDescr (Options -> IO Options)]
 options = [
-        Option "u" ["url"]
-            (ReqArg (\arg opt -> return opt { optURL = return arg })
+        Option "t" ["track"]
+            (ReqArg (\arg opt -> return opt { optTrackURL = return arg })
                 "URL")
-            "Track URL"
+            "Indicate the Track URL to be downloaded."
+      , Option "r" ["resolve"]
+            (ReqArg (\arg opt -> return opt { optResolve = return arg })
+                "URL")
+            "Resolve the API URL for an arbitrary URL. Supports users, tracks, sets, groups and apps"
       , Option "o" ["output"]
             (ReqArg
-                (\arg opt -> return opt { optOutput = writeFile arg })
-                "OUTPUT")
+                (\arg opt -> return opt { optOutput = return arg })
+                "FILE")
             "Output File"
       , Option "h" ["help"]
            (NoArg
 
 defaultOptions :: Options
 defaultOptions = Options
-    { optURL     = exitErrorHelp "use -u to indicate the track's URL"
-    , optOutput  = putStr
+    { optTrackURL       = Nothing
+    , optResolve        = Nothing
+    , optOutput         = Nothing
     }
 
+processOpts :: (Maybe String, Maybe String, Maybe String) -> IO ()
+processOpts opts@(a,b,c) =
+    if all (==Nothing) [a,b,c]
+    then exitErrorHelp "No options supplied"
+    else
+        case opts of
+          (Just a0, Nothing, Just c0)   -> scFetchTrack a0 c0
+          (Just a0, Nothing, Nothing)    -> scFetchTrack a0 ""
+          (Nothing, Just b0, Nothing)   ->
+              do uri <- scResolve b0
+                 putStrLn uri
+          (_, _, _)                  -> exitErrorHelp ""
+
+
 main :: IO ()
 main = do
      args <- getArgs
-     let (actions, nonOptions, errors) = getOpt RequireOrder options args
+     let (actions, _, _) = getOpt RequireOrder options args
 
      opts <- foldl (>>=) (return defaultOptions) actions
 
-     let Options { optURL = url
-                 , optOutput = output } = opts
-     strUrl <- url
-     scResolve strUrl
+     let Options { optTrackURL   = trackUrl
+                 , optResolve    = resolve
+                 , optOutput     = output
+                 } = opts
+     let optsTracker = (trackUrl, resolve, output)
 
+     processOpts optsTracker
 
 exitErrorHelp :: String -> IO a
 exitErrorHelp msg = do
 exitHelp :: IO a
 exitHelp = do
     showHelp
-    exitWith ExitSuccess
+    exitSuccess