-- | This module contain different general parsers.
module ID3.Parser.General where

----  IMPORTS
import Text.ParserCombinators.Poly.State
import ID3.Parser.UnSync
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Word (Word8)
import Bits
import Data.Accessor
import Data.Encoding
import Data.Encoding.ISO88591
import Data.Encoding.UTF8
import Data.Encoding.UTF16
import Data.ByteString.Lazy.UTF8 (toString)
import Codec.Binary.UTF8.String as Codec
----

---,--------------------------------
-- | Just a synonim for one item of input stream
type Token = Word8

-- | Parsers state
data St = State { tagPos         :: Integer  -- ^ current position in tag
--              , headerFlags    :: [Bool]   -- ^
--              , frFlags        :: [Bool]}  -- ^ current frame flags
                , curSize        :: Integer  -- ^ current frame size
                , curEncoding    :: Integer  -- ^ current frame encoding
                }

instance Show St where
    show st = show (tagPos st
                   ,curSize st
                   ,curEncoding st)
initState = State 0 10 0

type TagParser = Parser St Token

run :: TagParser a -> [Word8] -> (Either String a, [Token])
run p cont = (result, rest) where (result, _, rest) = runParser p initState cont

---,--------------------------------

-- pos = accessor (stGet >>= return . tagPos) (stUpdate $ \p st -> st {tagPos = p} )

-- | Returns 'tagPos' from 'St'.
posGet      :: TagParser Integer
posGet       = stGet >>= return . tagPos
-- | Updates 'tagPos' with given function.
posUpdate   :: (Integer -> Integer) -> TagParser ()
posUpdate f  = stUpdate ( \st -> st {tagPos = f (tagPos st)} )
-- | Sets 'tagPos' with given value.
posSet      :: Integer -> TagParser ()
posSet p     = posUpdate (\_ -> p)
-- | Decrements 'tagPos'.
posDec      :: TagParser ()
posDec       = posUpdate (\p -> p-1)
-- | Incremets 'tagPos'.
posInc      :: TagParser ()
posInc       = posUpdate (\p -> p+1)

---,--------------------------------
-- | Returns 'curSize' from 'St'.
sizeGet     :: TagParser Integer
sizeGet      = stGet >>= return . curSize
-- | Updates 'curSize' with given function.
sizeUpdate  :: (Integer -> Integer) -> TagParser ()
sizeUpdate f = stUpdate ( \st -> st {curSize = f (curSize st)} )
-- | Sets 'curSize' with given value.
sizeSet     :: Integer -> TagParser ()
sizeSet s    = sizeUpdate (\_ -> s)
-- | Decrements 'curSize'.
sizeDec     :: TagParser ()
sizeDec      = sizeUpdate (\x -> x-1)
-- | Incremets 'curSize'.
sizeInc     :: TagParser ()
sizeInc      = sizeUpdate (\x -> x+1)

---,--------------------------------
-- | Returns 'curEncoding' from 'St'.
encGet      :: TagParser Integer
encGet      = stGet >>= return . curEncoding
-- | Updates 'curEncoding' with given function.
encUpdate   :: (Integer -> Integer) -> TagParser ()
encUpdate f = stUpdate ( \st -> st {curEncoding = f (curEncoding st)} )
-- | Sets 'curEncoding' with given value.
encSet      :: Integer -> TagParser ()
encSet e    = encUpdate (\_ -> e)
-- | Parses one byte and sets 'curEncoding'.
encRead     :: TagParser Integer
encRead     = anyWord8 >>= encSet . toInteger >> encGet


---,--------------------------------
-- | Wrapper for /reiterative/ parsers.
--   Mnemonic: @if 'curSize' > 0 then@ continue @else@ stop
ifSize :: TagParser [a] -> TagParser [a]
ifSize p = do
    s <- sizeGet
    if s > 0
       then p
       else return []

-- | Wrapper for atomic parsers.
--   Increases 'tagPos' and decreases 'curSize'.
withSize p = do
    x <- p
    sizeDec
    posInc
    return x

--  Wrapper for any parser, that increaser tagPos and decreases curSize according to result of parsing
--   It is useful only for parsers, that return as much tokens, as they've read from the stream.
--   If result is list, then state updates according to it's length, else (!) result takes as a single-sized value.
{-withState :: TagParser a -> TagParser a
withState parser = do
        x <- parser
        case x of
            []    -> return x           -- empty list
            (_:_) -> do                 -- non-empty list
                    let n = toInteger $ length x
                    posUpdate (+n)
                    sizeUpdate (subtract n)
                    return x
            _     -> do                 -- singleton
                    posInc
                    sizeDec
                    return x
-}

---,--------------------------------
-- | @'many'' p@ parses a list of elements with individual parser @p@.
--   Cannot fail, since an empty list is a valid return value.
--   Unlike default 'many', stops if 'curSize' became 0.
many' :: TagParser a -> TagParser [a]
many' p = many1' p `onFail` return []

-- | Parse a non-empty list of items.
many1' :: TagParser a -> TagParser [a]
many1' p = ifSize $ do
    x <- p
    xs <- many' p
    return (x:xs)


---,--------------------------------
-- | @'manyTill'' p end@ parses a possibly-empty sequence of @p@'s, terminated by a @end@.
manyTill' :: TagParser a -> TagParser z -> TagParser [a]
manyTill' p end = manyTill1' p end `onFail` return []

-- | 'manyTill1\' p end' parses a non-empty sequence of p's, terminated by a end.
manyTill1' :: TagParser a -> TagParser z -> TagParser [a]
manyTill1' p end = ifSize $ (end >> return []) `onFail`
    (ifSize $ do
        x <- p
        xs <- manyTill' p end
        return (x:xs))

skipTill p end = end `onFail` do {p; skipTill p end}

---,--------------------------------
-- | Parse a list of items separated by discarded junk.
sepBy' :: TagParser a -> TagParser sep -> TagParser [a]
sepBy' p sep = sepBy1' p sep `onFail` return []

-- | Parse a non-empty list of items separated by discarded junk.
sepBy1' :: TagParser a -> TagParser sep -> TagParser [a]
sepBy1' p sep= ifSize $ do
    x <- p
    xs <- many' (sep >> p)
    return (x:xs)

---,--------------------------------
-- | 'count n p' parses a precise number of items, n, using the parser p, in sequence.
count :: (Num n) => n -> TagParser a -> TagParser [a]
count 0 _ = return []
count n p = do
    x <- p
    xs <- count (n-1) p
    return (x:xs)

-- | 'count' n p' parses a precise number of items, n, using the parser p, in sequence.
count' :: (Num n) => n -> TagParser a -> TagParser [a]
count' 0 _ = return []
count' n p = ifSize $ do
    x <- p
    xs <- count' (n-1) p
    return (x:xs)

---,--------------------------------
-- | Hybrid of 'count' and 'sepBy\''
countSepBy' :: (Num n) => n -> TagParser a -> TagParser sep -> TagParser [a]
countSepBy' 0 _ _ = return []
countSepBy' n p sep = ifSize $ do
    x <- p
    xs <- count' (n-1) (sep >> p)
    return (x:xs)

---,--------------------------------
-- | 'terminator' parses values termination symbol, according to current encoding ('curEncoding').
terminator :: TagParser [Token]
terminator = do
    enc <- encGet
    case enc of
         0x01 -> word8s [00,00]     -- UTF-16
         0x02 -> word8s [00,00]     -- UTF-16 BOM
         _    -> word8s [00]        -- ISO-8859-1 or UTF-8

encPack :: Integer -> [Token] -> String
encPack 0x00 = toString . recode' ISO88591 UTF8 . BS.pack . filter (/=00)
encPack 0x01 = toString . recode' UTF16 UTF8    . BS.pack . filter (/=00)
encPack 0x02 = toString . recode' UTF16 UTF8    . BS.pack . filter (/=00)
encPack _ = Codec.decode . filter (/=00)

recode' from to = Data.Encoding.encodeLazyByteString to . Data.Encoding.decodeLazyByteString from

---,--------------------------------
-- | Parses a list of values (as [Token]) separated with termination symbol
parseValues :: (Num n) => n -> TagParser [[Token]]
parseValues n = countSepBy' n (many' nonNull) terminator

-- | Parses one value (as [Token]) till termination symbol
parseValue :: TagParser [Token]
parseValue = nonNull `manyTill'` terminator

-- any byte except null
nonNull = withSize $ satisfy (/=0x00) `adjustErr` (++"\nWTF: nonNull")

-- | Parses one value and returns it as a 'String'
parseString :: TagParser String
parseString = do
    e <- encGet
    v <- parseValue
    return $ encPack e v -- C.unpack . BS.pack

-- | Parses one value and returns it as a 'Integer'
parseNumber :: TagParser Integer
parseNumber = parseValue >>= return . sum . (zipWith (*) (iterate (*10) 1)) . reverse . map toInteger

-- | Parses 3 bytes of language value (as a String) and returns a pair ("Language", value)
parseLanguage :: TagParser String
parseLanguage = do
    lang <- count' 3 anyWord8
    return $ encPack 0x03 lang

-- | Takes a list of keys and parses a list of values. Result is zip of these two lists.
formValues :: [String] -> TagParser [(String, String)]
formValues keys = do
    enc  <- encGet
    vals <- parseValues (length keys)
    return $ zip keys $ map (encPack enc) vals

--(<|>) = onFail

---,--------------------------------
-- | Takes a list of 'Parser's and applies them by turns.
parsers :: [TagParser a] -> TagParser [a]
parsers [] = return []
parsers (p:ps) = do
    x <- p
    xs <- parsers ps
    return (x:xs)

---,--------------------------------
-- | Parses given 'Token'.
word8 :: Token -> TagParser Token
word8 w = (withSize $ satisfy (==w)) `err` (" \nWTF: word8 "++(show w))

-- | Parses given list of 'Token's.
word8s :: [Token] -> TagParser [Token]
word8s ws = parsers $ map word8 ws

-- | Parses given 'ByteString'.
byteString :: BS.ByteString -> TagParser BS.ByteString
byteString bs = (word8s $ BS.unpack bs) >> return bs

-- | Same as 'byteString' but argument is simple 'String'.
string :: String -> TagParser BS.ByteString
string = byteString . C.pack

-- | Parses upper-case letters (as 'Token')
upper :: TagParser Token
upper = satisfy (\x -> (0x41<=x)&&(x<=0x5a)) `err` ("\nWTF: upper")

-- | Parses digit-symbol (as 'Token')
digit :: TagParser Token
digit = satisfy (\x -> (0x30<=x)&&(x<=0x39)) `err` ("\nWTF: digit")

---,--------------------------------
-- | Parses any 'Token'.
anyWord8 :: TagParser Token
anyWord8 = withSize next `err` "anyWord8"

err p s = do
    pos <- posGet
    p `adjustErr` (++"\n"++"at "++(show pos)++": "++s)

---,--------------------------------
type Size = Integer
-- | 'parseSize_ n' parses n bytes of synchronized size-value, and returns unsynchronized 'Integer' value.
parseSize_ :: Integer -> TagParser Size
parseSize_ n = do
    s <- count n next
    let size = unSynchronise s
    posUpdate (+n)
    sizeSet size
    return size

-- | Takes template of flags-byte and returns it as ['Bool'] value.
--   For example, for %abcd0000 template you should use 'parseFlags_ [1..4]'.
parseFlags_ :: [Int] -> TagParser [Bool]
parseFlags_ nums =  do
    flag <- anyWord8
    sizeInc
--    posInc
    return $ map (\i -> testBit flag (i-1)) nums