{-# LANGUAGE OverloadedStrings #-}

{-

This file is part of the Haskell package playlists. It is subject to
the license terms in the LICENSE file found in the top-level directory
of this distribution and at git://pmade.com/playlists/LICENSE. No part
of playlists package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
module Text.Playlist.M3U.Reader (parsePlaylist) where

--------------------------------------------------------------------------------
import Control.Applicative
import Control.Monad (void)
import Data.Attoparsec.ByteString
import Data.Attoparsec.ByteString.Char8 (signed, double)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import Text.Playlist.Internal.Attoparsec
import Text.Playlist.Types

--------------------------------------------------------------------------------
-- | Parser for a complete M3U playlist.
parsePlaylist :: Parser Playlist
parsePlaylist :: Parser Playlist
parsePlaylist = do
  Playlist
ts <- Parser ByteString Track -> Parser Playlist
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString Track
parseTrack
  Parser ByteString [Maybe (Maybe Text, Maybe Float)]
-> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString (Maybe (Maybe Text, Maybe Float))
-> Parser ByteString [Maybe (Maybe Text, Maybe Float)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser ByteString (Maybe (Maybe Text, Maybe Float))
commentOrDirective) -- Trailing comments.
  Playlist -> Parser Playlist
forall (m :: * -> *) a. Monad m => a -> m a
return Playlist
ts

--------------------------------------------------------------------------------
-- | Parser for a single track in a M3U file.
parseTrack :: Parser Track
parseTrack :: Parser ByteString Track
parseTrack = do
  -- Get the length and title closest to the URL or Nothing.
  (Maybe Text
title, Maybe Float
len) <- [Maybe (Maybe Text, Maybe Float)] -> (Maybe Text, Maybe Float)
forall a a. [Maybe (Maybe a, Maybe a)] -> (Maybe a, Maybe a)
maybeTitleAndLength ([Maybe (Maybe Text, Maybe Float)] -> (Maybe Text, Maybe Float))
-> ([Maybe (Maybe Text, Maybe Float)]
    -> [Maybe (Maybe Text, Maybe Float)])
-> [Maybe (Maybe Text, Maybe Float)]
-> (Maybe Text, Maybe Float)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Maybe Text, Maybe Float)]
-> [Maybe (Maybe Text, Maybe Float)]
forall a. [a] -> [a]
reverse ([Maybe (Maybe Text, Maybe Float)] -> (Maybe Text, Maybe Float))
-> Parser ByteString [Maybe (Maybe Text, Maybe Float)]
-> Parser ByteString (Maybe Text, Maybe Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Maybe (Maybe Text, Maybe Float))
-> Parser ByteString [Maybe (Maybe Text, Maybe Float)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser ByteString (Maybe (Maybe Text, Maybe Float))
commentOrDirective
  Text
url   <- Parser Text
parseURL
  Track -> Parser ByteString Track
forall (m :: * -> *) a. Monad m => a -> m a
return Track :: Text -> Maybe Text -> Maybe Float -> Track
Track { trackURL :: Text
trackURL      = Text
url
               , trackTitle :: Maybe Text
trackTitle    = Maybe Text
title
               , trackDuration :: Maybe Float
trackDuration = Maybe Float
len
               }
    where
      maybeTitleAndLength :: [Maybe (Maybe a, Maybe a)] -> (Maybe a, Maybe a)
maybeTitleAndLength [Maybe (Maybe a, Maybe a)]
lst =
        case [Maybe (Maybe a, Maybe a)] -> [(Maybe a, Maybe a)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Maybe a, Maybe a)]
lst of
          []    -> (Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)
          (Maybe a, Maybe a)
x : [(Maybe a, Maybe a)]
_ -> (Maybe a, Maybe a)
x
--------------------------------------------------------------------------------
-- | Parser for URL or file name in a M3U file.  The URL is the entire
-- line so this parser extracts the entire line and decodes it.
parseURL :: Parser Text
parseURL :: Parser Text
parseURL = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> Parser ByteString ByteString -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString ByteString
takeWhile1 (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
isEOL) Parser Text -> Parser ByteString () -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
skipSpace

--------------------------------------------------------------------------------
-- | Comment parser with a twist.  In the extended M3U format metadata
-- for a track can be placed in a comment that appears just before the
-- URL.  This parser succeeds if the current line is a comment, and
-- always skips over the entire comment.  If the comment represents an
-- EXTINF directive then that information will be returned in a @Just@.
-- If it's just a regular comment then @Nothing@ is returned.
commentOrDirective :: Parser (Maybe (Maybe Text, Maybe Float))
commentOrDirective :: Parser ByteString (Maybe (Maybe Text, Maybe Float))
commentOrDirective = do
  Parser ByteString ()
skipSpace
  (Word8 -> Bool) -> Parser ByteString ()
skip (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
35) -- Comment character "#"
  Bool
isDirective <- (ByteString -> Parser ByteString ByteString
string ByteString
"EXTINF:" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser ByteString Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  if Bool
isDirective then Parser ByteString (Maybe (Maybe Text, Maybe Float))
directive Parser ByteString (Maybe (Maybe Text, Maybe Float))
-> Parser ByteString (Maybe (Maybe Text, Maybe Float))
-> Parser ByteString (Maybe (Maybe Text, Maybe Float))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString (Maybe (Maybe Text, Maybe Float))
forall a. Parser ByteString (Maybe a)
comment else Parser ByteString (Maybe (Maybe Text, Maybe Float))
forall a. Parser ByteString (Maybe a)
comment
    where
      comment :: Parser ByteString (Maybe a)
comment   = Parser ByteString ()
skipLine Parser ByteString ()
-> Parser ByteString (Maybe a) -> Parser ByteString (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> Parser ByteString (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
      directive :: Parser ByteString (Maybe (Maybe Text, Maybe Float))
directive = do
        Maybe Float
mlen <- (Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float)
-> (Double -> Float) -> Double -> Maybe Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Maybe Float)
-> Parser ByteString Double -> Parser ByteString (Maybe Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Double -> Parser ByteString Double
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Double
double) Parser ByteString (Maybe Float)
-> Parser ByteString (Maybe Float)
-> Parser ByteString (Maybe Float)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Float -> Parser ByteString (Maybe Float)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Float
forall a. Maybe a
Nothing -- Parse length.
        (Word8 -> Bool) -> Parser ByteString ()
skip (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
44)                                                     -- Skip comma.
        Maybe Text
mtext <- (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> (ByteString -> Text) -> ByteString -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Maybe Text)
-> Parser ByteString ByteString -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString ByteString
takeWhile1 (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
isEOL)) Parser ByteString (Maybe Text)
-> Parser ByteString (Maybe Text) -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> Parser ByteString (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
        Parser ByteString ()
skipLine
        Maybe (Maybe Text, Maybe Float)
-> Parser ByteString (Maybe (Maybe Text, Maybe Float))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe Text, Maybe Float) -> Maybe (Maybe Text, Maybe Float)
forall a. a -> Maybe a
Just (Maybe Text
mtext, Maybe Float
mlen))