-- | This Module provides parsers for frames.
module ID3.Parser.Frame
where

---- IMPORTS
import Text.ParserCombinators.Poly.State

import ID3.Parser.General
import ID3.Parser.NativeFrames
import ID3.Type.Frame
import ID3.Type.Flags

import Data.Accessor
import Data.Map (Map)
import qualified Data.Map as Map

import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as C
----

parseFrames :: TagParser ([FrameID], Map FrameID ID3Frame)
parseFrames = do
    frames <- many1 anyFrame
    let idList = map (\f -> f^.frHeader^.frID) frames
    return ( idList , Map.fromList (zip idList frames) )

-- | Parses any Frame Header
anyFrameHeader :: TagParser FrameHeader
anyFrameHeader = do
    i <- frameID       `err` "frame id"
    s <- frameSize     `err` "frame size"
    f <- frameFlags    `err` "frame flags"
    return $ initFrameHeader [frID^=i, frSize^=s, frFlags^=f]

-- | Parses any Frame
anyFrame :: TagParser ID3Frame
anyFrame = do
    h <- anyFrameHeader               `err` "frame header"
    i <- frameInfo (h^.frID)          `err` "frame info"
    return $ initID3Frame [frHeader^=h, frInfo^=i]

-- | Parses Frame Header with given id
frameHeader :: FrameID -> TagParser FrameHeader
frameHeader i = do
    string i
    s <- frameSize
    f <- frameFlags
    return $ initFrameHeader [frID^=i, frSize^=s, frFlags^=f]

-- | Parses Frame with given id
parseFrame :: FrameID -> TagParser ID3Frame
parseFrame id = do
    h <- frameHeader id
    i <- frameInfo   id
    return $ initID3Frame [frHeader^=h, frInfo^=i]

frameID :: TagParser FrameID
frameID = do
    name <- count 4 $ upper `onFail` digit
    posUpdate (+4)
    return $ C.unpack $ BS.pack name

frameSize :: TagParser FrameSize
frameSize = parseSize_ 4

frameFlags = do
    s <- frameStatusFlags  `err` "status flags"
    f <- frameFormatFlags  `err` "format flags"
    return $ initFrameFlags [status^=s, format^=f]

frameStatusFlags = do
    fs <- parseFlags_ [2,3,4]
    return $ mkFlags [2,3,4] fs
    -- i.e. %0abc0000

frameFormatFlags = do
    fs <- parseFlags_ [2,5,6,7,8]
    return $ mkFlags [2,5,6,7,8] fs
    -- i.e. %0h00kmnp


-- {-- FRAME CONTENT
{-
 -If nothing else is said, strings, including numeric strings and URLs
 -   [URL], are represented as ISO-8859-1 [ISO-8859-1] characters in the
 -   range $20 - $FF. Such strings are represented in frame descriptions
 -   as <text string>, or <full text string> if newlines are allowed. If
 -   nothing else is said newline character is forbidden. In ISO-8859-1 a
 -   newline is represented, when allowed, with $0A only.
 -
 -   Frames that allow different types of text encoding contains a text
 -   encoding description byte. Possible encodings:
 -
 -     $00   ISO-8859-1 [ISO-8859-1]. Terminated with $00.
 -     $01   UTF-16 [UTF-16] encoded Unicode [UNICODE] with BOM. All
 -           strings in the same frame SHALL have the same byteorder.
 -           Terminated with $00 00.
 -     $02   UTF-16BE [UTF-16] encoded Unicode [UNICODE] without BOM.
 -           Terminated with $00 00.
 -     $03   UTF-8 [UTF-8] encoded Unicode [UNICODE]. Terminated with $00.
 -
 -   Strings dependent on encoding are represented in frame descriptions
 -   as <text string according to encoding>, or <full text string
 -   according to encoding> if newlines are allowed. Any empty strings of
 -   type $01 which are NULL-terminated may have the Unicode BOM followed
 -   by a Unicode NULL ($FF FE 00 00 or $FE FF 00 00).
 -
 -   The timestamp fields are based on a subset of ISO 8601. When being as
 -   precise as possible the format of a time string is
 -   yyyy-MM-ddTHH:mm:ss (year, "-", month, "-", day, "T", hour (out of
 -   24), ":", minutes, ":", seconds), but the precision may be reduced by
 -   removing as many time indicators as wanted. Hence valid timestamps
 -   are
 -   yyyy, yyyy-MM, yyyy-MM-dd, yyyy-MM-ddTHH, yyyy-MM-ddTHH:mm and
 -   yyyy-MM-ddTHH:mm:ss. All time stamps are UTC. For durations, use
 -   the slash character as described in 8601, and for multiple non-
 -   contiguous dates, use multiple strings, if allowed by the frame
 -   definition.
 -
 -   The three byte language field, present in several frames, is used to
 -   describe the language of the frame's content, according to ISO-639-2
 -   [ISO-639-2]. The language should be represented in lower case. If the
 -   language is not known the string "XXX" should be used.
 -
 -   All URLs [URL] MAY be relative, e.g. "picture.png", "../doc.txt".
 -
 -   If a frame is longer than it should be, e.g. having more fields than
 -   specified in this document, that indicates that additions to the
 -   frame have been made in a later version of the ID3v2 standard. This
 -   is reflected by the revision number in the header of the tag.
 --}