Commits

Sebastián Magrí committed 2968aca

Separate parsing logic per resource. A better solution may be considered to avoid repetition

  • Participants
  • Parent commits 60758fb

Comments (0)

Files changed (11)

File src/Network/SoundCloud.hs

-{-# LANGUAGE DeriveGeneric #-}
-
 {-
   Implementing the SoundCloud API
 -}
-module Network.SoundCloud where
+module Network.SoundCloud (
+  scGet,
+  scFetch,
+  scResolve,
+  scResourceType,
+  scShowInfo
+  ) where
 
-import Data.Aeson
-import qualified Data.ByteString.Lazy.Char8 as BSL
-import Data.List
-import Network.HTTP
-import System.IO
+import Network.SoundCloud.Util (scGet, scFetch, scResolve, scResourceType)
 
+import qualified Network.SoundCloud.App as App
+import qualified Network.SoundCloud.Comment as Comment
+import qualified Network.SoundCloud.Group as Group
+import qualified Network.SoundCloud.Set as Set
 import qualified Network.SoundCloud.Track as Track
 import qualified Network.SoundCloud.User as User
-import qualified Network.SoundCloud.Set as Set
-import qualified Network.SoundCloud.Group as Group
-import qualified Network.SoundCloud.Comment as Comment
-import qualified Network.SoundCloud.App as App
 
-clientId :: String
-clientId = "934a79db328a60a0ea459ab9e45c1735"
 
-apiURL :: String
-apiURL = "http://api.soundcloud.com"
+scResourceShowInfo :: String -> IO ()
+scResourceShowInfo url | scResourceType url == "track"   = Track.showInfo url
+                       | scResourceType url == "user"    = User.showInfo url
+                       | scResourceType url == "set"     = Set.showInfo url
+                       | scResourceType url == "group"   = Group.showInfo url
+                       | scResourceType url == "comment" = Comment.showInfo url
+                       | scResourceType url == "app"     = App.showInfo url
+scResourceShowInfo _                                     = putStrLn "Unrecognized resource"
 
-apiURLS :: String
-apiURLS = "https://api.soundcloud.com"
-
-apiMeURLS :: String
-apiMeURLS = apiURLS ++ "/me"
-
-authURLS :: String
-authURLS = "https://soundcloud.com/connect"
-
-tokenURLS :: String
-tokenURLS = apiURLS ++ "/oauth2/token"
-
-tracksURL :: String
-tracksURL = apiURL ++ "/tracks"
-
-usersURL :: String
-usersURL = apiURL ++ "/users"
-
-playlistsURL :: String
-playlistsURL = apiURL ++ "/playlists"
-
-groupsURL :: String
-groupsURL = apiURL ++ "/groups"
-
-commentsURL :: String
-commentsURL = apiURL ++ "/comments"
-
-meConnectionsURLS :: String
-meConnectionsURLS = apiMeURLS ++ "/connections"
-
-meActivitiesURLS :: String
-meActivitiesURLS = apiMeURLS ++ "/activities"
-
-appsURLS :: String
-appsURLS = apiURL ++ "/apps"
-
-resolveURL :: String
-resolveURL = apiURL ++ "/resolve"
-
-scGet :: String -> Bool -> IO (Maybe String)
-scGet url followRedirections =
-    do res <- simpleHTTP $ getRequest url
-       case res of
-         Left   _ -> return Nothing
-         Right  r ->
-             case rspCode r of
-               (2,_,_) -> return $ Just $ rspBody r
-               (3,_,_) ->
-                   case findHeader HdrLocation r of
-                     Nothing       -> return Nothing
-                     Just uri      ->
-                         if followRedirections
-                         then scGet uri True
-                         else return $ Just uri
-               _ -> return Nothing
-
-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
-
-
-scFetchTrack :: String -> String -> IO ()
-scFetchTrack trackUrl output =
-    do dat <- scGetInfo trackUrl
-       let o = decode (BSL.pack dat) :: Maybe Track.JsonRecord
-       case o of
-         Nothing        -> putStrLn "Unable to get track information."
-         Just obj       ->
-             if Track.downloadable obj then
-                 do let dUrlStr = concat [Track.download_url obj, "?client_id=", clientId]
-                    let filename = if null output then
-                                       "./" ++ Track.title obj ++ "." ++ Track.original_format obj
-                                   else output
-                    putStrLn $ "Fetching " ++ show (Track.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 just return the redirection Location
--}
-scResolve :: String -> IO String
-scResolve url =
-    do dat <- scGet resolveUrl False
-       case dat of
-         Nothing        -> return ""
-         Just d         -> return d
-    where
-        resolveUrl = concat [resolveURL, ".json?url=", url, "&client_id=", clientId]
-
-scResourceType :: String -> String
-scResourceType url | tracksURL    `isPrefixOf` url      = "track"
-                   | usersURL     `isPrefixOf` url      = "user"
-                   | playlistsURL `isPrefixOf` url      = "set"
-                   | groupsURL    `isPrefixOf` url      = "group"
-                   | commentsURL  `isPrefixOf` url      = "comment"
-                   | appsURLS     `isPrefixOf` url      = "app"
-scResourceType _                                        = ""
-
-
-{-
-Get the information about an arbitrary object given its URL
--}
-scGetInfo :: String -> IO String
-scGetInfo url =
-    do tUrl <- scResolve url
-       dat  <- scGetJSON tUrl
-       putStrLn $ scResourceType tUrl
-       return dat
+scShowInfo :: String -> IO ()
+scShowInfo url =
+    do rUrl <- scResolve url
+       scResourceShowInfo rUrl

File src/Network/SoundCloud/App.hs

 
 module Network.SoundCloud.App where
 
-import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson (FromJSON, ToJSON, decode)
+import qualified Data.ByteString.Lazy.Char8 as BSL
 import GHC.Generics (Generic)
 
 data JsonRecord = JsonRecord { id                     :: Int
 
 instance FromJSON JsonRecord
 instance ToJSON   JsonRecord
+
+decodeJSON :: String -> Maybe JsonRecord
+decodeJSON dat = decode (BSL.pack dat) :: Maybe JsonRecord
+
+showInfo :: String -> IO ()
+showInfo trackUrl = putStrLn "Not Implemented"

File src/Network/SoundCloud/Comment.hs

 
 module Network.SoundCloud.Comment where
 
-import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson (FromJSON, ToJSON, decode)
+import qualified Data.ByteString.Lazy.Char8 as BSL
 import GHC.Generics (Generic)
 
 import qualified Network.SoundCloud.User as User
 
 instance FromJSON JsonRecord
 instance ToJSON   JsonRecord
+
+decodeJSON :: String -> Maybe JsonRecord
+decodeJSON dat = decode (BSL.pack dat) :: Maybe JsonRecord
+
+showInfo :: String -> IO ()
+showInfo trackUrl = putStrLn "Not Implemented"

File src/Network/SoundCloud/Const.hs

+module Network.SoundCloud.Const where
+
+clientId :: String
+clientId = "934a79db328a60a0ea459ab9e45c1735"
+
+apiURL :: String
+apiURL = "http://api.soundcloud.com"
+
+apiURLS :: String
+apiURLS = "https://api.soundcloud.com"
+
+apiMeURLS :: String
+apiMeURLS = apiURLS ++ "/me"
+
+authURLS :: String
+authURLS = "https://soundcloud.com/connect"
+
+tokenURLS :: String
+tokenURLS = apiURLS ++ "/oauth2/token"
+
+tracksURL :: String
+tracksURL = apiURL ++ "/tracks"
+
+usersURL :: String
+usersURL = apiURL ++ "/users"
+
+playlistsURL :: String
+playlistsURL = apiURL ++ "/playlists"
+
+groupsURL :: String
+groupsURL = apiURL ++ "/groups"
+
+commentsURL :: String
+commentsURL = apiURL ++ "/comments"
+
+meConnectionsURLS :: String
+meConnectionsURLS = apiMeURLS ++ "/connections"
+
+meActivitiesURLS :: String
+meActivitiesURLS = apiMeURLS ++ "/activities"
+
+appsURLS :: String
+appsURLS = apiURL ++ "/apps"
+
+resolveURL :: String
+resolveURL = apiURL ++ "/resolve"

File src/Network/SoundCloud/Group.hs

 
 module Network.SoundCloud.Group where
 
-import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson (FromJSON, ToJSON, decode)
+import qualified Data.ByteString.Lazy.Char8 as BSL
 import GHC.Generics (Generic)
 
 import qualified Network.SoundCloud.User as User
 
 instance FromJSON JsonRecord
 instance ToJSON   JsonRecord
+
+decodeJSON :: String -> Maybe JsonRecord
+decodeJSON dat = decode (BSL.pack dat) :: Maybe JsonRecord
+
+showInfo :: String -> IO ()
+showInfo trackUrl = putStrLn "Not Implemented"

File src/Network/SoundCloud/MiniUser.hs

+{-# LANGUAGE DeriveGeneric #-}
+
+module Network.SoundCloud.MiniUser where
+
+import Data.Aeson (FromJSON, ToJSON, decode)
+import qualified Data.ByteString.Lazy.Char8 as BSL
+import GHC.Generics (Generic)
+
+data JsonRecord = JsonRecord { id               :: Int
+                             , username         :: String
+                             , uri              :: String
+                             , permalink_url    :: String
+                             , avatar_url       :: Maybe String
+                             } deriving (Show, Generic)
+
+instance FromJSON JsonRecord
+instance ToJSON   JsonRecord
+
+decodeJSON :: String -> Maybe JsonRecord
+decodeJSON dat = decode (BSL.pack dat) :: Maybe JsonRecord

File src/Network/SoundCloud/Set.hs

 
 module Network.SoundCloud.Set where
 
-import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson (FromJSON, ToJSON, decode)
+import qualified Data.ByteString.Lazy.Char8 as BSL
 import GHC.Generics (Generic)
 
 import qualified Network.SoundCloud.User as User
 
 instance FromJSON JsonRecord
 instance ToJSON   JsonRecord
+
+decodeJSON :: String -> Maybe JsonRecord
+decodeJSON dat = decode (BSL.pack dat) :: Maybe JsonRecord
+
+showInfo :: String -> IO ()
+showInfo trackUrl = putStrLn "Not Implemented"

File src/Network/SoundCloud/Track.hs

 
 module Network.SoundCloud.Track where
 
-import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson (FromJSON, ToJSON, decode)
+import qualified Data.ByteString.Lazy.Char8 as BSL
+import Data.Maybe (fromJust)
 import GHC.Generics (Generic)
+import Text.Printf (printf)
 
-import qualified Network.SoundCloud.User as User
+import Network.SoundCloud.Util (scGet, scFetch, scResolve)
+import Network.SoundCloud.Const (clientId)
+import qualified Network.SoundCloud.MiniUser as User
 
-data JsonRecord = JsonRecord { id                     :: Int
-                             , created_at             :: String
-                             , user                   :: User.JsonRecord
-                             , title                  :: String
-                             , permalink_url          :: String
-                             , sharing                :: String
-                             , description            :: String
-                             , label                  :: User.JsonRecord
-                             , duration               :: Int
-                             , genre                  :: String
-                             , shared_to_count        :: Int
-                             , license                :: String
-                             , release_day            :: Int
-                             , release_month          :: Int
-                             , release_year           :: Int
-                             , streamable             :: Bool
-                             , downloadable           :: Bool
-                             , track_type             :: String
-                             , download_url           :: String
-                             , stream_url             :: String
-                             , bpm                    :: Int
-                             , comment_count          :: Int
-                             , download_count         :: Int
-                             , playback_count         :: Int
-                             , favoritings_count      :: Int
-                             , original_format        :: String
-                             , original_content_size  :: Int
---                             , created_with           :: App.JsonRecord
-                             } deriving (Show, Generic)
+data Json = Json { id                     :: Int
+                 , created_at             :: String
+                 , user                   :: User.JsonRecord
+                 , title                  :: String
+                 , permalink_url          :: String
+                 , sharing                :: String
+                 , description            :: String
+                 , label_id               :: Maybe Int
+                 , label_name             :: Maybe String
+                 , duration               :: Int
+                 , genre                  :: String
+                 , license                :: String
+                 , release_day            :: Maybe Int
+                 , release_month          :: Maybe Int
+                 , release_year           :: Maybe Int
+                 , streamable             :: Bool
+                 , downloadable           :: Bool
+                 , track_type             :: String
+                 , stream_url             :: String
+                 , bpm                    :: Maybe Int
+                 , comment_count          :: Int
+                 , download_count         :: Int
+                 , playback_count         :: Int
+                 , favoritings_count      :: Int
+                 , original_format        :: String
+                 , original_content_size  :: Int
+                 , tag_list               :: String
+                 } deriving (Show, Generic)
 
-instance FromJSON JsonRecord
-instance ToJSON   JsonRecord
+instance FromJSON Json
+instance ToJSON   Json
+
+data DownloadJson = DownloadJson { download_url     :: String
+                                 } deriving (Show, Generic)
+
+instance FromJSON DownloadJson
+instance ToJSON   DownloadJson
+
+decodeJson :: String -> Maybe Json
+decodeJson dat = decode (BSL.pack dat) :: Maybe Json
+
+getJson :: String -> IO (Maybe Json)
+getJson url =
+    do tUrl <- scResolve url
+       dat  <- scGet tUrl True
+       case dat of
+         Nothing -> return Nothing
+         Just d  -> return $ decodeJson d
+
+decodeDownloadJson :: String -> Maybe DownloadJson
+decodeDownloadJson dat = decode (BSL.pack dat) :: Maybe DownloadJson
+
+fetch :: String -> String -> IO ()
+fetch trackUrl output =
+    do tUrl <- scResolve trackUrl
+       dat <- scGet tUrl True
+       case dat of
+         Nothing -> putStrLn "Unable to connect"
+         Just d  ->
+             do let o = decodeJson d
+                case o of
+                  Nothing        -> putStrLn "Unable to get track information."
+                  Just obj       ->
+                      if downloadable obj then
+                          do let obj0 = decodeDownloadJson d
+                             let dUrlStr = concat [download_url $ fromJust obj0, "?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"
+
+showInfo :: String -> IO ()
+showInfo trackUrl =
+    do obj <- getJson trackUrl
+       case obj of
+         Nothing        -> putStrLn "Unable to get track information."
+         Just o         ->
+             do let tmp = "%s\n%s - %s\n\t%s\nPlays: %d\nComments: %d\nDownloads: %d\nTags:%s\n"
+                printf
+                  tmp
+                  (permalink_url o)
+                  (title o)
+                  (User.username $ user o)
+                  (description o)
+                  (playback_count o)
+                  (comment_count o)
+                  (download_count o)
+                  (tag_list o)

File src/Network/SoundCloud/User.hs

 
 module Network.SoundCloud.User where
 
-import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson (FromJSON, ToJSON, decode)
+import qualified Data.ByteString.Lazy.Char8 as BSL
 import GHC.Generics (Generic)
 
 data JsonRecord = JsonRecord { id                     :: Int
+                             , uri                    :: String
                              , permalink_url          :: String
                              , country                :: String
                              , full_name              :: String
 
 instance FromJSON JsonRecord
 instance ToJSON   JsonRecord
+
+decodeJSON :: String -> Maybe JsonRecord
+decodeJSON dat = decode (BSL.pack dat) :: Maybe JsonRecord
+
+showInfo :: String -> IO ()
+showInfo trackUrl = putStrLn "Not Implemented"

File src/Network/SoundCloud/Util.hs

+module Network.SoundCloud.Util where
+
+import Data.List
+import Network.HTTP
+import System.IO
+
+import Network.SoundCloud.Const
+
+scGet :: String -> Bool -> IO (Maybe String)
+scGet url followRedirections =
+    do res <- simpleHTTP $ getRequest url
+       case res of
+         Left   _ -> return Nothing
+         Right  r ->
+             case rspCode r of
+               (2,_,_) -> return $ Just $ rspBody r
+               (3,_,_) ->
+                   case findHeader HdrLocation r of
+                     Nothing       -> return Nothing
+                     Just uri      ->
+                         if followRedirections
+                         then scGet uri True
+                         else return $ Just uri
+               _ -> return Nothing
+
+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
+
+scResourceType :: String -> String
+scResourceType url | tracksURL    `isPrefixOf` url      = "track"
+                   | usersURL     `isPrefixOf` url      = "user"
+                   | playlistsURL `isPrefixOf` url      = "set"
+                   | groupsURL    `isPrefixOf` url      = "group"
+                   | commentsURL  `isPrefixOf` url      = "comment"
+                   | appsURLS     `isPrefixOf` url      = "app"
+scResourceType _                                        = ""
+
+{-
+This function's request will always return a (3,_,_) status,
+so we can just return the redirection Location
+-}
+scResolve :: String -> IO String
+scResolve url =
+    do dat <- scGet resolveUrl False
+       case dat of
+         Nothing        -> return ""
+         Just d         -> return d
+    where
+        resolveUrl = concat [resolveURL, ".json?url=", url, "&client_id=", clientId]
+
 import System.Console.GetOpt
 import System.Environment
 
-import Network.SoundCloud
+import Network.SoundCloud (scResolve, scShowInfo)
+import qualified Network.SoundCloud.Track as Track
 
 data Options = Options { optTrackURL    :: Maybe String
+                       , optOutput      :: Maybe String
+                       , optInfo        :: Maybe String
                        , optResolve     :: Maybe String
-                       , optOutput      :: Maybe String
                        }
 
 options :: [OptDescr (Options -> IO Options)]
         Option "t" ["track"]
             (ReqArg (\arg opt -> return opt { optTrackURL = return arg })
                 "URL")
-            "Indicate the Track URL to be downloaded."
-      , Option "r" ["resolve"]
-            (ReqArg (\arg opt -> return opt { optResolve = return arg })
-                "URL")
-            "Resolve the SoundCloud's API URL for an arbitrary URL. Supports users, tracks, sets, groups and apps"
+            "Indicate the URL of the track to be downloaded."
       , Option "o" ["output"]
             (ReqArg
                 (\arg opt -> return opt { optOutput = return arg })
                 "FILE")
             "Output File"
+      , Option "i" ["info"]
+            (ReqArg
+                (\arg opt -> return opt { optInfo = return arg })
+                "URL")
+            "Get info about the resource pointed by the URL"
+      , Option "r" ["resolve"]
+            (ReqArg (\arg opt -> return opt { optResolve = return arg })
+                "URL")
+            "Resolve the SoundCloud's API URL for an arbitrary URL. Supports users, tracks, sets, groups and apps"
       , Option "h" ["help"]
-           (NoArg
-               (\_ -> exitHelp))
-           "Show usage info"
+            (NoArg
+                (\_ -> exitHelp))
+            "Show usage info"
       ]
 
 defaultOptions :: Options
 defaultOptions = Options
     { optTrackURL       = Nothing
+    , optOutput         = Nothing
+    , optInfo           = 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 ""
+processOpts :: (Maybe String, Maybe String, Maybe String, Maybe String) -> IO ()
+processOpts opts =
+    case opts of
+      (Just a0, Just b0, Nothing, Nothing)   -> Track.fetch a0 b0
+      (Just a0, Nothing, Nothing, Nothing)   -> Track.fetch a0 ""
+      (Nothing, Nothing, Just c0, Nothing)   -> scShowInfo c0
+      (Nothing, Nothing, Nothing, Just d0)   ->
+          do uri <- scResolve d0
+             putStrLn uri
+      (_, _, _, _)                  -> exitErrorHelp ""
 
 
 main :: IO ()
      opts <- foldl (>>=) (return defaultOptions) actions
 
      let Options { optTrackURL   = trackUrl
+                 , optOutput     = output
+                 , optInfo       = info
                  , optResolve    = resolve
-                 , optOutput     = output
                  } = opts
-     let optsTracker = (trackUrl, resolve, output)
+     let optsTracker = (trackUrl, output, info, resolve)
 
      processOpts optsTracker