{-# 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 a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return 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 a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
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 a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
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 a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
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 a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> Parser ByteString (Maybe a)
forall a. a -> Parser ByteString 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 a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Float -> Parser ByteString (Maybe Float)
forall a. a -> Parser ByteString a
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 a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> Parser ByteString (Maybe Text)
forall a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
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))