module ID3.Type.Frame where

import Data.Accessor
import Data.Accessor.Basic (compose)
import ID3.Type.Flags
import ID3.Type.Unparse
import ID3.Type.FrameInfo
import Numeric
import Data.Char
import Data.Word

{-- | /ID3V2 FRAME OVERVIEW/

    All ID3v2 frames consists of one frame header followed by one or more
   fields containing the actual information. The header is always 10
   bytes and laid out as follows:

@
     Frame ID      $xx xx xx xx  (four characters)
     Size      4 * %0xxxxxxx
     Flags         $xx xx
@
--}


data ID3Frame = ID3Frame
                { frHeader_  :: FrameHeader    -- ^ frame Header
                , frInfo_    :: FrameInfo      -- ^ frame Information Value
                }   deriving Eq

emptyID3Frame :: ID3Frame
emptyID3Frame = ID3Frame emptyFrameHeader (Unknown [])
initID3Frame :: [ID3Frame -> ID3Frame] -> ID3Frame
initID3Frame  = flip compose emptyID3Frame

frHeader :: Accessor ID3Frame FrameHeader
frHeader = accessor frHeader_ (\x fr -> fr {frHeader_ = x})
frInfo :: Accessor ID3Frame FrameInfo
frInfo   = accessor frInfo_   (\x fr -> fr {frInfo_   = x})

instance HasSize ID3Frame where
    size = accessor (toInteger . length . unparse . getVal frInfo) (setVal $ frHeader .> frSize)

--content :: (FrameInfo -> a) -> Accessor ID3Frame a
--content a = accessor (\f -> a (f^.frInfo)) (\x f -> frInfo^=((f^.frInfo) {a=x}) $ f)
textContent :: Accessor ID3Frame String
textContent  = frInfo .> infoTextContent

instance Show ID3Frame where
    show fr = (show $ fr^.frHeader) ++"\n"++
              (show $ fr^.frInfo  )++"\n"

{-showFrameInfo info = concatMap showRec info
        where showRec (s, bs) = "\t"++s++":\t"++bs++"\n"-}

instance Parsed ID3Frame where
    unparse fr = (unparse $ fr^.frHeader) ++
                 (unparse $ fr^.frInfo  )

type FrameName = String

{-type FrameInfo = [(String, String)]-}

{- | Frame Header
-}
data FrameHeader = FrameHeader
                { frID_    :: FrameID         -- ^ frame ID
                , frSize_  :: FrameSize       -- ^ frame Size
                , frFlags_ :: FrameFlags      -- ^ frame Flags
                }   deriving Eq

emptyFrameHeader :: FrameHeader
emptyFrameHeader = FrameHeader "" 0 emptyFrameFlags
initFrameHeader :: [FrameHeader -> FrameHeader] -> FrameHeader
initFrameHeader  = flip compose emptyFrameHeader

frID :: Accessor FrameHeader FrameID
frID    = accessor frID_    (\x h -> h {frID_    = x})
frSize :: Accessor FrameHeader FrameSize
frSize  = accessor frSize_  (\x h -> h {frSize_  = x})
frFlags :: Accessor FrameHeader FrameFlags
frFlags = accessor frFlags_ (\x h -> h {frFlags_ = x})


instance Show FrameHeader where
    show (FrameHeader i s fs) = "\tFrame ID:\t"++i++"\n"++
                                "\tFrame size:\t"++(show s)++
                                (show fs)

instance Parsed FrameHeader where
    unparse fh = (unparse $ Str $ fh^.frID      ) ++
                 (unparse $ fh^.frSize          ) ++
                 (unparse $ fh^.frFlags         )

{-- | /FRAME ID/

    The frame ID is made out of the characters capital A-Z and 0-9.
   Identifiers beginning with "X", "Y" and "Z" are for experimental
   frames and free for everyone to use, without the need to set the
   experimental bit in the tag header. Bear in mind that someone else
   might have used the same identifier as you. All other identifiers are
   either used or reserved for future use.
--}
type FrameID = String

{-- | /SIZE BYTES/

   The frame ID is followed by a size descriptor containing the size of
   the data in the final frame, after encryption, compression and
   unsynchronisation. The size is excluding the frame header ('total
   frame size' - 10 bytes) and stored as a 32 bit synchsafe integer.
--}
type FrameSize = Integer

{-- | /Frame header flags/

   In the frame header the size descriptor is followed by two flag
   bytes. All unused flags MUST be cleared. The first byte is for
   'status messages' and the second byte is a format description. If an
   unknown flag is set in the first byte the frame MUST NOT be changed
   without that bit cleared. If an unknown flag is set in the second
   byte the frame is likely to not be readable. Some flags in the second
   byte indicates that extra information is added to the header. These
   fields of extra information is ordered as the flags that indicates
   them. The flags field is defined as follows (l and o left out because
   ther resemblence to one and zero):

@
     %0abc0000 %0h00kmnp
@

   Some frame format flags indicate that additional information fields
   are added to the frame. This information is added after the frame
   header and before the frame data in the same order as the flags that
   indicates them. I.e. the four bytes of decompressed size will precede
   the encryption method byte. These additions affects the 'frame size'
   field, but are not subject to encryption or compression.

   The default status flags setting for a frame is, unless stated
   otherwise, 'preserved if tag is altered' and 'preserved if file is
   altered', i.e. @%00000000@.
--}
data FrameFlags = FrameFlags
                  { statusFlags_ :: StatusFlags   -- ^ Frame status flags
                  , formatFlags_ :: FormatFlags   -- ^ Frame format flags
                  } deriving Eq

emptyFrameFlags :: FrameFlags
emptyFrameFlags = FrameFlags (StatusFlags 4 (False, False, False))
                             (FormatFlags 4 (False, False, False, False, False))
initFrameFlags :: [FrameFlags -> FrameFlags] -> FrameFlags
initFrameFlags  = flip compose emptyFrameFlags

statusFlags :: Accessor FrameFlags StatusFlags
statusFlags = accessor statusFlags_ (\x fs -> fs {statusFlags_ = x})
formatFlags :: Accessor FrameFlags FormatFlags
formatFlags = accessor formatFlags_ (\x fs -> fs {formatFlags_ = x})

instance Show FrameFlags where
  show fs = if not ((anyStatusFlagsOn $ fs^.statusFlags) || (anyFormatFlagsOn $ fs^.formatFlags))
            then "" else
              "\tFlags " ++ (showBinary $ unparse $ fs^.statusFlags) ++
              " " ++ (showBinary $ unparse $ fs^.formatFlags) ++ ":\n"++
              (showStatusFlags $ fs^.statusFlags) ++ "\n" ++
              (showFormatFlags $ fs^.formatFlags)

instance Parsed FrameFlags where
    unparse fs = (unparse $ fs^.statusFlags) ++ (unparse $ fs^.formatFlags)

{-- | /Frame status flags/

    Format: @%0abc0000@ where

   a - /Tag alter preservation/

     This flag tells the tag parser what to do with this frame if it is
     unknown and the tag is altered in any way. This applies to all
     kinds of alterations, including adding more padding and reordering
     the frames.

@
     0     Frame should be preserved.
     1     Frame should be discarded.
@

   b - /File alter preservation/

     This flag tells the tag parser what to do with this frame if it is
     unknown and the file, excluding the tag, is altered. This does not
     apply when the audio is completely replaced with other audio data.

@
     0     Frame should be preserved.
     1     Frame should be discarded.
@

   c - /Read only/

      This flag, if set, tells the software that the contents of this
      frame are intended to be read only. Changing the contents might
      break something, e.g. a signature. If the contents are changed,
      without knowledge of why the frame was flagged read only and
      without taking the proper means to compensate, e.g. recalculating
      the signature, the bit MUST be cleared.
--}
data StatusFlags = StatusFlags Word8 (Bool, Bool, Bool) deriving Eq

frameDiscardFlag :: StatusFlags -> Bool
frameDiscardFlag (StatusFlags _ (a, _, _)) = a
fileDiscardFlag :: StatusFlags -> Bool
fileDiscardFlag  (StatusFlags _ (_, b, _)) = b
readOnlyFlag :: StatusFlags -> Bool
readOnlyFlag     (StatusFlags _ (_, _, c)) = c
anyStatusFlagsOn :: StatusFlags -> Bool
anyStatusFlagsOn (StatusFlags _ (a, b, c)) = a || b || c

showBinary :: [Word8] -> String
showBinary [n] = 
  pad $ showIntAtBase 2 intToDigit n ""
  where
    pad s = replicate (8 - length s) '0' ++ s
showBinary _ = error "internal error: flags unparsed incorrectly"

showStatusFlags :: StatusFlags -> String
showStatusFlags stat = if not (anyStatusFlagsOn stat) then "" else "\t\tStatus Flags:\n" ++ finfo
  where finfo = (if frameDiscardFlag stat then "\t\t\t- Frame should be discarded when tag is altered\n" else "") ++
                (if fileDiscardFlag stat  then "\t\t\t- Frame should be discarded when file contents are altered\n" else "") ++
                (if readOnlyFlag stat     then "\t\t\t- Frame is read only!\n"                else "")

instance Parsed StatusFlags where
    unparse (StatusFlags v (a, b, c)) = 
      case v of
        3 -> [flagsToWord8 (a, b, c, False, False, False, False, False)]
        4 -> [flagsToWord8 (False, a, b, c, False, False, False, False)]
        _ -> [0]

{-- | /Frame format flags/

    Format: @%0h00kmnp@ where

   h - /Grouping identity/

      This flag indicates whether or not this frame belongs in a group
      with other frames. If set, a group identifier byte is added to the
      frame. Every frame with the same group identifier belongs to the
      same group.

@
      0     Frame does not contain group information
      1     Frame contains group information
@

   k - /Compression/

      This flag indicates whether or not the frame is compressed.
      A 'Data Length Indicator' byte MUST be included in the frame.

@
      0     Frame is not compressed.
      1     Frame is compressed using zlib [zlib] deflate method.
            If set, this requires the 'Data Length Indicator' bit
            to be set as well.
@

   m - /Encryption/

      This flag indicates whether or not the frame is encrypted. If set,
      one byte indicating with which method it was encrypted will be
      added to the frame. See description of the ENCR frame for more
      information about encryption method registration. Encryption
      should be done after compression. Whether or not setting this flag
      requires the presence of a 'Data Length Indicator' depends on the
      specific algorithm used.

@
      0     Frame is not encrypted.
      1     Frame is encrypted.
@

   n - /Unsynchronisation/

      This flag indicates whether or not unsynchronisation was applied
      to this frame. See section 6 for details on unsynchronisation.
      If this flag is set all data from the end of this header to the
      end of this frame has been unsynchronised. Although desirable, the
      presence of a 'Data Length Indicator' is not made mandatory by
      unsynchronisation.

@
      0     Frame has not been unsynchronised.
      1     Frame has been unsyrchronised.
@

   p - /Data length indicator/

      This flag indicates that a data length indicator has been added to
      the frame. The data length indicator is the value one would write
      as the 'Frame length' if all of the frame format flags were
      zeroed, represented as a 32 bit synchsafe integer.
@
      0      There is no Data Length Indicator.
      1      A data length Indicator has been added to the frame.
@
--}
data FormatFlags = FormatFlags Word8 (Bool, Bool, Bool, Bool, Bool) deriving Eq

groupPartFlag :: FormatFlags -> Bool
groupPartFlag     (FormatFlags _ (h, _, _, _, _)) = h    -- Grouping identity
compressedFlag :: FormatFlags -> Bool
compressedFlag    (FormatFlags _ (_, k, _, _, _)) = k    -- Compression
encryptedFlag :: FormatFlags -> Bool
encryptedFlag     (FormatFlags _ (_, _, m, _, _)) = m    -- Encryption
unsychronisedFlag :: FormatFlags -> Bool
unsychronisedFlag (FormatFlags _ (_, _, _, n, _)) = n    -- Unsynchronisation
dataLengthIdFlag :: FormatFlags -> Bool
dataLengthIdFlag  (FormatFlags _ (_, _, _, _, p)) = p    -- Data length indicator
anyFormatFlagsOn :: FormatFlags -> Bool
anyFormatFlagsOn  (FormatFlags _ (h, k, m, n, p)) = h || k || m || n || p

showFormatFlags :: FormatFlags -> String
showFormatFlags fs = if not (anyFormatFlagsOn fs) then "" else finfo
  where finfo = "\t\tFormat Flags:\n" ++ (concat $ map (\i -> "\t\t\t- " ++ i ++ "\n") items)
        items = [] ++
                (if groupPartFlag     fs then ["frame is a part of group"]        else []) ++
                (if compressedFlag    fs then ["frame is compressed"]             else []) ++
                (if encryptedFlag     fs then ["frame is encrypted"]              else []) ++
                (if unsychronisedFlag fs then ["frame is unsynchronised"]         else []) ++
                (if dataLengthIdFlag  fs then ["frame has data length indicator"] else [])

instance Parsed FormatFlags where
    unparse (FormatFlags v (h, k, m, n, p)) =
      case v of
        3 -> [flagsToWord8 (k, m, h, False, False, False, False, False)]
        4 -> [flagsToWord8 (False, h, False, False, k, m, n, p)]
        _ -> [0]

--------------------------------------------------------------------------------------------


initFrame :: FrameID -> ID3Frame
initFrame frid = updateSize $ initID3Frame [ frHeader.>frID ^= frid, frInfo ^= inf ]
    where inf = case frid of
            "UFID" -> UFID "" []
            "TXXX" -> TXXX 03 "" ""
            "TCMP" -> TCMP False
            ('T':_)-> Text 03 ""
            "WXXX" -> WXXX 03 "" ""
            ('W':_)-> URL  ""
            "MCDI" -> MCDI []
            --ETCO -- { format :: Integer
                -- , events :: [Event]} -- TODO
            --MLLT -- TODO
            --SYTC -- TODO
            "USLT" -> USLT 03 "eng" "" ""
            --SYLT enc lang timeFormat content descr
            "COMM" -> COMM 03 "eng" "" ""
            --RVA2 -- TODO
            --EQU2 -- TODO
            --RVRB -- TODO
            "APIC" -> APIC 03 "" 00 "" []
            --GEOB -- TODO
            "PCNT" -> PCNT 00
            "POPM" -> POPM "" 00 00
            --RBUF -- TODO
            --AENC -- TODO
            --LINK -- TODO
            --POSS -- TODO
            "USER" -> USER 03 "eng" ""
            --OWNE -- TODO
            --COMR -- TODO
            --ENCR -- TODO
            --GRID -- TODO
            "PRIV" -> PRIV "" []
            --SIGN -- TODO
            --ASPI -- TODO
            _      -> Unknown []