{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

module MusicScroll.TrackInfo where

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

data TrackInfo = TrackInfo
  { TrackInfo -> Text
tTitle :: Text,
    TrackInfo -> Text
tArtist :: Text, -- xesam:artist is weird
    TrackInfo -> SongFilePath
tUrl :: SongFilePath
  }
  deriving (Int -> TrackInfo -> ShowS
[TrackInfo] -> ShowS
TrackInfo -> SongFilePath
(Int -> TrackInfo -> ShowS)
-> (TrackInfo -> SongFilePath)
-> ([TrackInfo] -> ShowS)
-> Show TrackInfo
forall a.
(Int -> a -> ShowS)
-> (a -> SongFilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TrackInfo -> ShowS
showsPrec :: Int -> TrackInfo -> ShowS
$cshow :: TrackInfo -> SongFilePath
show :: TrackInfo -> SongFilePath
$cshowList :: [TrackInfo] -> ShowS
showList :: [TrackInfo] -> ShowS
Show)

data TrackByPath = TrackByPath
  { TrackByPath -> SongFilePath
tpPath :: SongFilePath,
    TrackByPath -> Maybe Text
tpTitle :: Maybe Text, -- Best effort
    TrackByPath -> Maybe Text
tpArtist :: Maybe Text -- Best effort
  }
  deriving (Int -> TrackByPath -> ShowS
[TrackByPath] -> ShowS
TrackByPath -> SongFilePath
(Int -> TrackByPath -> ShowS)
-> (TrackByPath -> SongFilePath)
-> ([TrackByPath] -> ShowS)
-> Show TrackByPath
forall a.
(Int -> a -> ShowS)
-> (a -> SongFilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TrackByPath -> ShowS
showsPrec :: Int -> TrackByPath -> ShowS
$cshow :: TrackByPath -> SongFilePath
show :: TrackByPath -> SongFilePath
$cshowList :: [TrackByPath] -> ShowS
showList :: [TrackByPath] -> ShowS
Show)

type SongFilePath = FilePath

type TrackIdentifier = Either TrackByPath TrackInfo

newtype TrackIdentifierWithEq = TIWE TrackIdentifier

instance Eq TrackIdentifierWithEq where
  (TIWE TrackIdentifier
t1) == :: TrackIdentifierWithEq -> TrackIdentifierWithEq -> Bool
== (TIWE TrackIdentifier
t2) = TrackIdentifier -> SongFilePath
extractUrl TrackIdentifier
t1 SongFilePath -> SongFilePath -> Bool
forall a. Eq a => a -> a -> Bool
== TrackIdentifier -> SongFilePath
extractUrl TrackIdentifier
t2

extractUrl :: TrackIdentifier -> SongFilePath
extractUrl :: TrackIdentifier -> SongFilePath
extractUrl = (TrackByPath -> SongFilePath)
-> (TrackInfo -> SongFilePath) -> TrackIdentifier -> SongFilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TrackByPath -> SongFilePath
tpPath TrackInfo -> SongFilePath
tUrl

pattern OnlyMissingArtist :: TrackByPath
pattern $mOnlyMissingArtist :: forall {r}. TrackByPath -> ((# #) -> r) -> ((# #) -> r) -> r
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 :: forall (m :: * -> *).
(MonadState ConnState m, MonadIO m) =>
m (Either DBusError TrackIdentifier)
tryGetInfo = do
  (ConnState Client
client BusName
busName) <- m ConnState
forall s (m :: * -> *). MonadState s m => m s
get
  IO (Either DBusError TrackIdentifier)
-> m (Either DBusError TrackIdentifier)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either DBusError TrackIdentifier)
 -> m (Either DBusError TrackIdentifier))
-> IO (Either DBusError TrackIdentifier)
-> m (Either DBusError TrackIdentifier)
forall a b. (a -> b) -> a -> b
$ do
    Either DBusError (Map Text Variant)
metadata <-
      ((MethodError -> DBusError)
-> Either MethodError (Map Text Variant)
-> Either DBusError (Map Text Variant)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first MethodError -> DBusError
NoMusicClient)
        (Either MethodError (Map Text Variant)
 -> Either DBusError (Map Text Variant))
-> IO (Either MethodError (Map Text Variant))
-> IO (Either DBusError (Map Text Variant))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Client -> MethodCall -> IO (Either MethodError (Map Text Variant))
forall a.
IsValue a =>
Client -> MethodCall -> IO (Either MethodError a)
getPropertyValue
          Client
client
          (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
mediaObject InterfaceName
mediaInterface MemberName
"Metadata")
            { methodCallDestination :: Maybe BusName
methodCallDestination = BusName -> Maybe BusName
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BusName
busName
            }
    Either DBusError TrackIdentifier
-> IO (Either DBusError TrackIdentifier)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DBusError TrackIdentifier
 -> IO (Either DBusError TrackIdentifier))
-> (Either DBusError (Either DBusError TrackIdentifier)
    -> Either DBusError TrackIdentifier)
-> Either DBusError (Either DBusError TrackIdentifier)
-> IO (Either DBusError TrackIdentifier)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either DBusError (Either DBusError TrackIdentifier)
-> Either DBusError TrackIdentifier
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either DBusError (Either DBusError TrackIdentifier)
 -> IO (Either DBusError TrackIdentifier))
-> Either DBusError (Either DBusError TrackIdentifier)
-> IO (Either DBusError TrackIdentifier)
forall a b. (a -> b) -> a -> b
$ Map Text Variant -> Either DBusError TrackIdentifier
obtainTrackInfo (Map Text Variant -> Either DBusError TrackIdentifier)
-> Either DBusError (Map Text Variant)
-> Either DBusError (Either DBusError TrackIdentifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either DBusError (Map Text Variant)
metadata

obtainTrackInfo :: Map Text Variant -> Either DBusError TrackIdentifier
obtainTrackInfo :: Map Text Variant -> Either DBusError TrackIdentifier
obtainTrackInfo Map Text Variant
metadata =
  let lookup' :: IsVariant a => Text -> Maybe a
      lookup' :: forall a. IsVariant a => Text -> Maybe a
lookup' Text
name = Text -> Map Text Variant -> Maybe Variant
forall k a. Ord k => k -> Map k a -> Maybe a
lookup Text
name Map Text Variant
metadata Maybe Variant -> (Variant -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Variant -> Maybe a
forall a. IsVariant a => Variant -> Maybe a
fromVariant

      mTitle :: Maybe Text
mTitle = Text -> Maybe Text
forall a. IsVariant a => Text -> Maybe a
lookup' Text
"xesam:title"
      mArtist :: Maybe Text
mArtist = Maybe Text -> Maybe [Text] -> Maybe Text
xesamArtistFix (Text -> Maybe Text
forall a. IsVariant a => Text -> Maybe a
lookup' Text
"xesam:artist") (Text -> Maybe [Text]
forall a. IsVariant a => Text -> Maybe a
lookup' Text
"xesam:artist")
      mUrl :: Maybe SongFilePath
mUrl = ShowS
vlcFix ShowS -> Maybe SongFilePath -> Maybe SongFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe SongFilePath
forall a. IsVariant a => Text -> Maybe a
lookup' Text
"xesam:url"

      trackInfo :: Maybe TrackInfo
      trackInfo :: Maybe TrackInfo
trackInfo = Text -> Text -> SongFilePath -> TrackInfo
TrackInfo (Text -> Text -> SongFilePath -> TrackInfo)
-> Maybe Text -> Maybe (Text -> SongFilePath -> TrackInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mTitle Maybe (Text -> SongFilePath -> TrackInfo)
-> Maybe Text -> Maybe (SongFilePath -> TrackInfo)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text
mArtist Maybe (SongFilePath -> TrackInfo)
-> Maybe SongFilePath -> Maybe TrackInfo
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe SongFilePath
mUrl

      trackByPath :: Maybe TrackByPath
      trackByPath :: Maybe TrackByPath
trackByPath = SongFilePath -> Maybe Text -> Maybe Text -> TrackByPath
TrackByPath (SongFilePath -> Maybe Text -> Maybe Text -> TrackByPath)
-> Maybe SongFilePath
-> Maybe (Maybe Text -> Maybe Text -> TrackByPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SongFilePath
mUrl Maybe (Maybe Text -> Maybe Text -> TrackByPath)
-> Maybe (Maybe Text) -> Maybe (Maybe Text -> TrackByPath)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
mTitle Maybe (Maybe Text -> TrackByPath)
-> Maybe (Maybe Text) -> Maybe TrackByPath
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
mArtist

      trackIdent :: Maybe TrackIdentifier
      trackIdent :: Maybe TrackIdentifier
trackIdent = (TrackInfo -> TrackIdentifier
forall a b. b -> Either a b
Right (TrackInfo -> TrackIdentifier)
-> Maybe TrackInfo -> Maybe TrackIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TrackInfo
trackInfo) Maybe TrackIdentifier
-> Maybe TrackIdentifier -> Maybe TrackIdentifier
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (TrackByPath -> TrackIdentifier
forall a b. a -> Either a b
Left (TrackByPath -> TrackIdentifier)
-> Maybe TrackByPath -> Maybe TrackIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TrackByPath
trackByPath)
   in Either DBusError TrackIdentifier
-> (TrackIdentifier -> Either DBusError TrackIdentifier)
-> Maybe TrackIdentifier
-> Either DBusError TrackIdentifier
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DBusError -> Either DBusError TrackIdentifier
forall a b. a -> Either a b
Left DBusError
NoSong) TrackIdentifier -> Either DBusError TrackIdentifier
forall a b. b -> Either a b
Right Maybe TrackIdentifier
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 :: Maybe Text -> Maybe [Text] -> Maybe Text
xesamArtistFix (Just Text
title) Maybe [Text]
_ = Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
title
xesamArtistFix Maybe Text
Nothing (Just [Text]
arr) | (Text
title : [Text]
_) <- [Text]
arr = Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
title
xesamArtistFix Maybe Text
_ Maybe [Text]
_ = Maybe Text
forall a. Maybe a
Nothing

cleanTrack :: Functor m => Pipe TrackIdentifier TrackIdentifier m a
cleanTrack :: forall (m :: * -> *) a.
Functor m =>
Pipe TrackIdentifier TrackIdentifier m a
cleanTrack = (TrackIdentifier -> TrackIdentifier)
-> Pipe TrackIdentifier TrackIdentifier m a
forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
PP.map TrackIdentifier -> TrackIdentifier
go
  where
    go :: TrackIdentifier -> TrackIdentifier
    go :: TrackIdentifier -> TrackIdentifier
go =
      (TrackByPath -> TrackByPath)
-> (TrackInfo -> TrackInfo) -> TrackIdentifier -> TrackIdentifier
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
        ( \TrackByPath
byPath ->
            let newTitle :: Maybe Text
newTitle = Text -> Text
cleanTitle (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TrackByPath -> Maybe Text
tpTitle TrackByPath
byPath
             in TrackByPath
byPath {tpTitle :: Maybe Text
tpTitle = Maybe Text
newTitle}
        )
        (\TrackInfo
track -> TrackInfo
track {tTitle :: Text
tTitle = Text -> Text
cleanTitle (TrackInfo -> Text
tTitle TrackInfo
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 :: Text -> Text
cleanTitle Text
title0 =
  let (Text
title1, Text
format) = (Text -> Text) -> (Text, Text) -> (Text, Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first HasCallStack => Text -> Text
Text -> Text
T.init ((Text, Text) -> (Text, Text)) -> (Text, Text) -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOnEnd Text
"." Text
title0
      title2 :: Text
title2 = if Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
format [Text]
musicFormats then Text
title1 else Text
title0
   in (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlpha) Text
title2

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

vlcFix :: SongFilePath -> SongFilePath
vlcFix :: ShowS
vlcFix = Text -> SongFilePath
T.unpack (Text -> SongFilePath) -> (SongFilePath -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"%20" Text
" " (Text -> Text) -> (SongFilePath -> Text) -> SongFilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"file://" Text
"" (Text -> Text) -> (SongFilePath -> Text) -> SongFilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SongFilePath -> Text
T.pack