Soma FM player

{-# LANGUAGE OverloadedStrings, NamedFieldPuns, LambdaCase #-}

import Control.Applicative
import Data.List
import Data.Map (Map)
import Data.Maybe
import qualified Data.Map as M
import Data.Ord
import Data.Text (Text)
import qualified Data.Text as T
import Network.HTTP.Conduit
import Text.HTML.DOM
import Text.XML hiding (parseLBS)
import Text.XML.Cursor
import System.Environment
import System.Process

qualityPriority :: Map Text Int
qualityPriority = M.fromList $ zip qualities [0..]
  where
    qualities =
      [ "AAC 128kb"
      , "AAC-HE 64kb"
      , "MP3 128kb"
      , "AAC-HE 32kb"
      , "MP3 56kb"
      , "MP3 24kb"
      ]

getLinksPage :: String -> IO Cursor
getLinksPage radio = do
  page <- simpleHttp $ "http://somafm.com/" ++ radio ++ "/directstreamlinks.html"
  return $ fromDocument $ parseLBS page

data Stream = Stream
  { description :: Text
  , urls :: [ ( Text, String ) ]
  , priority :: Int
  } deriving ( Show )

streamLink :: Cursor -> [ ( Text, String ) ]
streamLink c = maybeToList $ do
  NodeElement (Element
    { elementName = "p"
    , elementAttributes
    , elementNodes = [ NodeContent link ] } ) <- return (node c)
  "url" <- M.lookup "class" elementAttributes
  [ desc, url ] <- return $ T.splitOn ": " link
  return ( desc, T.unpack url ) 

stream :: Cursor -> [ Stream ]
stream c = maybeToList $ do
  NodeElement (Element
    { elementName = "h2"
    , elementNodes = [ NodeContent description ] }) <- return (node c)
  priority <- M.lookup description qualityPriority
  let urls = concat $ takeWhile (not . null) $ map streamLink (c $| followingSibling >=> anyElement)
  return $ Stream { description, priority, urls }

getStreams :: String -> IO [ Stream ]
getStreams radio = ($//stream) <$> getLinksPage radio

bestStream :: [ Stream ] -> Stream
bestStream = minimumBy (comparing (priority))

main = getArgs >>= \case
  [ radio ] -> do
    streams <- getStreams radio
    if null streams
      then putStrLn "No streams found."
      else let ( _, url ) : _ = urls $ bestStream streams in
        callProcess "mplayer" [ "-playlist", url ]
  _ -> putStrLn "Usage: soma [radio]"