Browse Source

use the hackage version of libmpd, clean shit up

master
nisstyre56 9 years ago
parent
commit
1278aeb09a
  1. 45
      Database.hs
  2. 4
      Main.hs
  3. 6
      Types.hs
  4. 20
      Utils.hs

45
Database.hs

@ -2,6 +2,8 @@
module Database where
import qualified Network.MPD as MP
import Network.MPD.Applicative.Status
import Network.MPD.Core
import Types
import Search
import qualified Unsafe.Coerce as C
@ -13,6 +15,7 @@ import qualified Data.ByteString as B
import Data.String.Utils
import Data.Maybe
import Control.Applicative
import Utils
{-
- unsafeCoerce is needed because the "Path"
@ -28,22 +31,44 @@ toPath = C.unsafeCoerce . BC.pack . strip . head . split "\n"
toValue :: B.ByteString -> MP.Value
toValue = C.unsafeCoerce
changeTitle :: TIO.Text -> Maybe MP.Song -> IO (MP.Response ())
changeTitle _ Nothing = error "empty playlist"
fromId :: MP.Id -> Int
fromId = C.unsafeCoerce
changeTitle title' (Just song) = do
let title = encodeUtf8 title'
changeTag :: MP.Metadata -> TIO.Text -> Maybe MP.Song -> IO (MP.Response [B.ByteString])
changeTag _ _ Nothing = error "empty playlist"
changeTag tag tagval' (Just song) = do
let tagval = encodeUtf8 tagval'
case (MP.sgId song) of
Nothing -> error "tried to modify a non-existent track"
(Just sid) -> do
MP.withMPD $
MP.addTagId sid MP.Title (toValue title)
(Just sid) -> addTagId sid tag (BC.unpack tagval)
changeArtist = changeTag MP.Artist
changeTitle = changeTag MP.Title
changeBoth track (artist, title) =
changeArtist artist track >>
changeTitle title track
addTagId :: MP.Id -> MP.Metadata -> String -> IO (Response [B.ByteString])
addTagId sid tag tagVal = MP.withMPD $
getResponse $
"addtagid " ++
(show $ fromId sid) ++
" " ++
(show tag) ++
" \"" ++
tagVal ++
" \""
addSingle :: SearchResult -> IO (MP.Response ())
addSingle :: SearchResult -> IO (Response [B.ByteString])
addSingle track = do
let trackUrl = url track
let trackTitle = title track
let trackDesc = title track
fullUrl <- readProcess "youtube-dl" ["-g", "-f", "bestaudio", (TIO.unpack trackUrl)] ""
MP.withMPD $ MP.add $ toPath fullUrl
(Right pl) <- (MP.withMPD $ MP.playlistInfo Nothing)
changeTitle trackTitle (listToMaybe $ reverse pl)
let lastTrack = listToMaybe $ reverse pl
either (const $ changeTitle trackDesc lastTrack)
(changeBoth lastTrack)
(parseTrack trackDesc)

4
Main.hs

@ -10,5 +10,5 @@ import qualified Data.Text.IO as TIO (putStrLn)
main = do
term <- getArgs
result <- firstResult $ intercalate " " term
addSingle result
result <- search $ intercalate " " term
mapM_ addSingle result

6
Types.hs

@ -40,24 +40,30 @@ data SearchResult = SearchResult {
instance FromJSON URL where
parseJSON (Object v) = URL <$> v .: "url"
parseJSON _ = error "invalid parse"
instance FromJSON Thumbnail where
parseJSON (Object v) = Thumbnail <$> v .: "default"
parseJSON _ = error "invalid parse"
instance FromJSON VideoID where
parseJSON (Object v) = VideoID <$>
v .: "videoId"
parseJSON _ = error "invalid parse"
instance FromJSON Snippet where
parseJSON (Object v) = Snippet <$>
v .: "title" <*>
v .: "description" <*>
v .: "thumbnails"
parseJSON _ = error "invalid parse"
instance FromJSON JSearchResult where
parseJSON (Object v) = JSearchResult <$>
(v .: "id") <*>
(v .: "snippet")
parseJSON _ = error "invalid parse"
instance FromJSON JItems where
parseJSON (Object v) = JItems <$> v .: "items"
parseJSON _ = error "invalid parse"

20
Utils.hs

@ -0,0 +1,20 @@
{-# LANGUAGE OverloadedStrings #-}
module Utils where
import Types
import qualified Data.Text as TIO
import Data.Text.Encoding
import Data.Maybe
import Control.Applicative
import Data.Attoparsec.Text
isSep = string "by" <|>
string " - " <|>
string "- "
isTrack = do
artist <- manyTill anyChar isSep
title <- many1 anyChar
return (TIO.pack artist, TIO.pack title)
parseTrack = parseOnly isTrack