TrackInfo.hs

{-# language OverloadedStrings, NamedFieldPuns, FlexibleContexts, PatternSynonyms #-}
module MusicScroll.TrackInfo where

import           Prelude hiding (readFile, lookup)
import           Control.Applicative (Alternative(..))
import           Control.Monad (join)
import           Control.Monad.State.Class (MonadState(..))
import           DBus
import           DBus.Client
import           Data.Bifunctor (first, bimap)
import           Data.Map.Strict (Map, lookup)
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Char (isAlpha)
import qualified Pipes.Prelude as PP (map)

import           MusicScroll.DBusNames
import           MusicScroll.ConnState

import Pipes

data TrackInfo = TrackInfo
  { tTitle  :: Text
  , tArtist :: Text -- xesam:artist is weird
  , tUrl    :: SongFilePath
  } deriving (Show)

data TrackByPath = TrackByPath
  { tpPath :: SongFilePath
  , tpTitle :: Maybe Text -- Best effort
  , tpArtist :: Maybe Text -- Best effort
  } deriving (Show)

type SongFilePath = FilePath
type TrackIdentifier = Either TrackByPath TrackInfo

newtype TrackIdentifierWithEq = TIWE TrackIdentifier

instance Eq TrackIdentifierWithEq where
  (TIWE t1) == (TIWE t2) = extractUrl t1 == extractUrl t2

extractUrl :: TrackIdentifier -> SongFilePath
extractUrl = either tpPath tUrl

pattern OnlyMissingArtist :: TrackByPath
pattern OnlyMissingArtist <- TrackByPath {tpArtist = Nothing, tpTitle = Just _}


data DBusError = NoMusicClient MethodError | NoSong

-- An exception here means that either there is not a music player
-- running or what it is running it's not a song. Either way we should
-- wait for a change on the dbus connection to try again.
tryGetInfo :: (MonadState ConnState m, MonadIO m) =>
  m (Either DBusError TrackIdentifier)
tryGetInfo = do
  (ConnState client busName) <- get
  liftIO $ do
    metadata <- (first NoMusicClient) <$> getPropertyValue client
      (methodCall mediaObject mediaInterface "Metadata") {
        methodCallDestination = pure busName
      }
    pure . join $ obtainTrackInfo <$> metadata

obtainTrackInfo :: Map Text Variant -> Either DBusError TrackIdentifier
obtainTrackInfo metadata =
  let lookup' :: IsVariant a => Text -> Maybe a
      lookup' name = lookup name metadata >>= fromVariant

      mTitle  = lookup' "xesam:title"
      mArtist = xesamArtistFix (lookup' "xesam:artist") (lookup' "xesam:artist")
      mUrl    = vlcFix <$> lookup' "xesam:url"

      trackInfo :: Maybe TrackInfo
      trackInfo = TrackInfo <$> mTitle <*> mArtist <*> mUrl

      trackByPath :: Maybe TrackByPath
      trackByPath = TrackByPath <$> mUrl <*> pure mTitle <*> pure mArtist

      trackIdent :: Maybe TrackIdentifier
      trackIdent =  (Right <$> trackInfo) <|> (Left <$> trackByPath)
  in maybe (Left NoSong) Right trackIdent

-- xesam:artist by definition should return a `[Text]`, but in practice
-- it returns a `Text`. This function makes it always return `Text`.
xesamArtistFix :: Maybe Text -> Maybe [Text] -> Maybe Text
xesamArtistFix (Just title) _ = pure title
xesamArtistFix Nothing (Just arr) | (title : _) <- arr = pure title
xesamArtistFix _ _ = Nothing

cleanTrack :: Functor m => Pipe TrackIdentifier TrackIdentifier m a
cleanTrack = PP.map go
  where
    go :: TrackIdentifier -> TrackIdentifier
    go = bimap (\byPath -> let newTitle = cleanTitle <$> tpTitle byPath
                           in byPath { tpTitle = newTitle })
               (\track -> track { tTitle = cleanTitle (tTitle track) })

-- | This functions does two main things:
--     1. Remove format at the end, ie .mp3, .opus etc.
--     2. Remove the leading order separators, ie "05 - song name" ->
--        "song name"
cleanTitle :: Text -> Text
cleanTitle title0 =
  let (title1, format) = first T.init $ T.breakOnEnd "." title0
      title2 = if elem format musicFormats then title1 else title0
  in T.dropWhile (not . isAlpha) title2

musicFormats :: [Text]
musicFormats = ["mp3", "flac", "ogg", "wav", "acc", "opus", "webm"]

vlcFix :: SongFilePath -> SongFilePath
vlcFix = T.unpack . T.replace "%20" " " . T.replace "file://" "" . T.pack