    {-# LANGUAGE Rank2Types #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Prompt.MPD
    -- Copyright   :  Daniel Schoepe <daniel.schoepe@googlemail.com>
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  Daniel Schoepe <daniel.schoepe@googlemail.com>
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- This module lets the user select songs and have MPD add/play them by
    -- filtering them by user-supplied criteria(E.g. ask for an artist, then for
    -- the album..)
    --
    -----------------------------------------------------------------------------

    module XMonad.Prompt.MPD (-- * Usage
                              -- $usage
                              findMatching,
                              findMatchingWith,
                              addMatching,
                              addMatchingWith,
                              addAndPlay,
                              addAndPlayWith,
                              loadPlaylist,
                              loadPlaylistWith,
                              addAndPlayAny,
                              pickPlayListItem,
                              RunMPD,
                              findOrAdd
                             )  where
    import Control.Monad
    import Data.Char
    import Data.List as L
    import qualified Data.Map as M
    import Data.Maybe
    import Data.String
    import Network.MPD
    import XMonad hiding ((=?))
    import XMonad.Prompt
    import Data.List as L (find, isPrefixOf, nub)
    import qualified Data.ByteString.Char8 as C

    -- $usage
    --
    -- To use this, import the following modules:
    --
    -- > import XMonad.Prompt.MPD
    -- > import qualified Network.MPD as MPD
    --
    -- You can then use this in a keybinding, to filter first by artist, then by
    -- album and add the matching songs:
    --
    -- > addMatching MPD.withMPD defaultXPConfig [MPD.Artist, MPD.Album] >> return ()
    --
    -- That way you will first be asked for an artist name, then for an album by
    -- that artist etc..
    --
    -- If you need a password to connect to your MPD or need a different host/port,
    -- you can pass a partially applied withMPDEx to the function:
    --
    -- > addMatching (MPD.withMPDEx "your.host" 4242 "very secret") ..
    --

    -- | Allows the user to supply a custom way to connect to MPD (e.g. partially
    -- applied withMPDEx).
    type RunMPD = forall a . MPD a -> IO (Response a)

    -- | A new prompt type since Prompt.Input causes problems when completing
    -- strings with spaces in them
    data MPDPrompt = MPDPrompt String

    instance XPrompt MPDPrompt where
        showXPrompt (MPDPrompt s) = s ++ ": "
        nextCompletion = const getNextCompletion
        commandToComplete = const id

    -- | Extracts the given metadata attribute from a Song
    extractMetadata :: Metadata -> Song -> String
    extractMetadata meta = fromMaybe "Unknown" . join . fmap listToMaybe .
                           M.lookup meta . M.map (map toString) . sgTags

    -- | Creates a case-insensitive completion function from a list.
    mkComplLst :: (String -> String -> Bool) -> [String] -> String -> IO [String]
    mkComplLst cmp lst s = return . filter matches $ lst
        where matches s' = map toLower s `cmp` map toLower s'

    -- | Helper function for 'findMatching'
    findMatching' :: (String -> String -> Bool) -> XPConfig -> [Song] -> Metadata
                  -> X [Song]
    findMatching' _ _ [] _ = return []
    findMatching' cmp xp songs meta = do
      answer <- mkXPromptWithReturn (MPDPrompt (show meta)) xp
               (mkComplLst cmp . nub . map (extractMetadata meta) $ songs)
               return
      case answer of
        Just input -> return $ filter ((==input) . extractMetadata meta) songs
        Nothing -> return []

    extractSongs :: [LsResult] -> [Song]
    extractSongs = mapMaybe extractSong
        where extractSong (LsSong s) = Just s
              extractSong _ = Nothing

    -- | Lets the user filter out non-matching songs. For example, if given
    -- [Artist, Album] as third argument, this will prompt the user for an
    -- artist(with tab-completion), then for an album by that artist and then
    -- returns the songs from that album.
    --
    -- @since 0.13.2
    findMatchingWith :: (String -> String -> Bool) -> RunMPD -> XPConfig
                     -> [Metadata] -> X [Song]
    findMatchingWith matchFun runMPD xp metas = do
      resp <- io . runMPD . fmap extractSongs . listAllInfo $ ("" :: Path)
      case resp of
        Left err -> trace ("XMonad.Prompt.MPD: MPD returned an error: " ++ show err)
                    >> return []
        Right songs -> foldM (findMatching' matchFun xp) songs metas

    -- | Lets the user filter out non-matching songs. For example, if given
    -- [Artist, Album] as third argument, this will prompt the user for an
    -- artist(with tab-completion), then for an album by that artist and then
    -- returns the songs from that album.
    findMatching :: RunMPD -> XPConfig -> [Metadata] -> X [Song]
    findMatching = findMatchingWith isPrefixOf

    -- | Determine playlist position of the song and add it, if it isn't present.
    findOrAdd :: Song -> MPD Int
    findOrAdd s = playlistInfo Nothing >>= \pl ->
      case L.find ((== sgFilePath s) . sgFilePath) pl of
        Just (Song { sgIndex = Just i }) -> return i
        _ -> fmap unwrapId . flip addId Nothing . sgFilePath $ s
      where unwrapId (Id i) = i

    -- | Add all selected songs to the playlist if they are not in it.
    --
    -- @since 0.13.2
    addMatchingWith :: (String -> String -> Bool) -> RunMPD -> XPConfig
                    -> [Metadata] -> X [Int]
    addMatchingWith matchFun runMPD xp metas = do
      matches <- findMatchingWith matchFun runMPD xp metas
      fmap (either (const []) id) . io . runMPD . mapM findOrAdd $ matches

    -- | Add all selected songs to the playlist if they are not in it.
    addMatching :: RunMPD -> XPConfig -> [Metadata] -> X [Int]
    addMatching = addMatchingWith isPrefixOf

    -- | Add matching songs and play the first one.
    --
    -- @since 0.13.2
    addAndPlayWith :: (String -> String -> Bool) -> RunMPD -> XPConfig
                   -> [Metadata] -> X ()
    addAndPlayWith matchFun runMPD xp ms = do
      ids <- addMatchingWith matchFun runMPD xp ms
      whenJust (listToMaybe ids) ((>> return ()) . io . runMPD . playId . Id)

    -- | Add matching songs and play the first one.
    addAndPlay :: RunMPD ->  XPConfig -> [Metadata] -> X ()
    addAndPlay = addAndPlayWith isPrefixOf

    -- | Load an existing playlist and play it.
    --
    -- @since 0.13.2
    loadPlaylistWith :: (String -> String -> Bool) -> RunMPD ->  XPConfig -> X ()
    loadPlaylistWith matchFun runMPD xp = do
      playlists <- fmap (either (const []) id) . io . runMPD $ listPlaylists
      mkXPrompt (MPDPrompt "Playlist: ") xp
        (mkComplLst matchFun . nub . map toString $ playlists)
        (\s -> do io $ runMPD $ do clear
                                   load $ PlaylistName $ C.pack s
                                   play Nothing
                  return ())

    -- | Load an existing playlist and play it.
    loadPlaylist :: RunMPD ->  XPConfig -> X ()
    loadPlaylist = loadPlaylistWith isPrefixOf

    -- | Add songs which match all of the given words with regard to any
    -- of the metadata.
    --
    -- @since 0.13.2
    addAndPlayAny :: RunMPD -> XPConfig -> [Metadata] -> X ()
    addAndPlayAny runMPD xp metas = do
      mkXPrompt (MPDPrompt "Search") xp
        (historyCompletionP (showXPrompt (MPDPrompt "Search: ") ==))
        (\s -> do io $ runMPD $ do
                    clear
                    songlists <- mapM (\t -> do
                                          sl <- mapM (\m -> search
                                                            (m =? fromString t))
                                                metas
                                          return $ concat sl) $ words s
                    let songs = foldl L.intersect (head songlists) songlists
                    fmap (either (const []) id) . io . runMPD . mapM findOrAdd $
                      songs
                    play Nothing
                  return ())

    -- | Pick a song from the current playlist.
    --
    -- @since 0.13.2
    pickPlayListItem :: RunMPD -> XPConfig -> X ()
    pickPlayListItem runMPD xp = do
      mkXPrompt (MPDPrompt "Pick") xp
        (\s -> do pSongs <- io $ runMPD $ playlistSearch (Title =? fromString s)
                  case pSongs of
                    Left _ -> return []
                    Right songs -> return $ take 100 $ nub $ map toString
                                   $ concat $ catMaybes
                                   $ map (M.lookup Title . sgTags) songs)
        (\s -> do io $ runMPD $ do
                    pSongs <- io $ runMPD $ playlistSearch (Title =? fromString s)
                    case pSongs of
                      Left _      -> return ()
                      Right songs -> case sgId $ head songs of
                                       Nothing    -> return ()
                                       Just theId -> playId theId
                  return ())