{-# 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,
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,
TrackByPath -> Maybe Text
tpArtist :: Maybe Text
}
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
= (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
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
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)})
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