-- |
--   Copyright   :  (c) Sam Truzjan 2013
--   License     :  BSD3
--   Maintainer  :  pxqr.sta@gmail.com
--   Stability   :  stable
--   Portability :  portable
--
--   This module provides bencode values serialization. Normally, you
--   don't need to import this module, use 'Data.BEncode' instead.
--
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE CPP #-}
module Data.BEncode.Internal
       ( -- * Parsing
         parser
       , parse

         -- * Rendering
       , builder
       , build
       , ppBEncode
       ) where

import Control.Applicative
import           Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Attoparsec.ByteString.Char8 as P
import           Data.ByteString as B
import           Data.ByteString.Internal as B (c2w, w2c)
import qualified Data.ByteString.Lazy as Lazy
#if MIN_VERSION_bytestring(0,10,0)
import qualified Data.ByteString.Lazy.Builder as B
import qualified Data.ByteString.Lazy.Builder.ASCII as B
#else
import qualified Data.ByteString.Builder as B
-- import qualified Data.ByteString.Builder.ASCII as B
-- import qualified Data.ByteString.Builder.Internal as B
#endif
import Data.Foldable
import Data.List as L
import Data.Monoid
import Text.PrettyPrint hiding ((<>))
import Data.Char
import Data.Maybe

import Data.BEncode.Types
import Data.BEncode.BDict as BD

import GHC.Types
import GHC.Integer.GMP.Internals

{--------------------------------------------------------------------
-- Serialization
--------------------------------------------------------------------}

integerDecimal :: Integer -> B.Builder
integerDecimal (S# i#) = B.intDec (I# i#)
integerDecimal  i      = B.string7 (show i) -- TODO more efficient

-- | BEncode format encoder according to specification.
builder :: BValue -> B.Builder
builder = go
    where
      go (BInteger i) = B.word8 (c2w 'i') <>
                          integerDecimal i <>
                        B.word8 (c2w 'e')
      go (BString  s) = buildString s
      go (BList    l) = B.word8 (c2w 'l') <>
                        foldMap go l <>
                        B.word8 (c2w 'e')
      go (BDict    d) = B.word8 (c2w 'd') <>
                        bifoldMap mkKV d <>
                        B.word8 (c2w 'e')
          where
            mkKV k v = buildString k <> go v

      buildString s = B.intDec (B.length s) <>
                      B.word8 (c2w ':') <>
                      B.byteString s
      {-# INLINE buildString #-}

-- | Convert bencoded value to raw bytestring according to the
-- specification.
build :: BValue -> Lazy.ByteString
build = B.toLazyByteString . builder


sample = "lld10:xOo@-ovQ\b}i8eeded12:]\ENQ89gJp\DC1Y\t!]17:\SOHRQ8\DLE\ESC\NULiUSRo\t.M<gei18eldede8:VX^ejm\SO_d12:.J*\DLEIc\SIV\ESCun\SOHdeede8:tg!\"lU\SOH\DEL1:Pe16:X\EMk\ESCGaek)\DC4'\t+\ESChhei-7e16:<OJ\v9\".i;\DC4[=]_D9de16:$-giCtwedm!\CAN\aA\DC3{dee"

{--------------------------------------------------------------------
-- Deserialization
--------------------------------------------------------------------}

-- TODO try to replace peekChar with something else
-- | BEncode format parser according to specification.
parser :: Parser BValue
parser = valueP Nothing
  where
    valueP prior = do
      mc <- maybe (optional P.anyChar) (return . Just) prior
      case mc of
        Nothing -> fail "end of input"
        Just c  ->
            case c of
              -- if we have digit it always should be string length
              di | '0' <= di && di <= '9' -> BString <$> stringP c
              'i' -> ((BInteger <$> integerP)  <* P.char 'e') --  P.anyChar)
              'l' -> ((BList    <$> listBodyP) ) -- <* P.anyChar)
              'd' ->  (BDict    <$> dictBodyP) -- <* P.anyChar
              t   -> fail ("bencode unknown tag: " ++ [t])

    dictBodyP :: Parser BDict
    dictBodyP =
            (P.char 'e' *> pure Nil)
            <|> do c <- P.satisfy isDigit -- P.anyChar
                   Cons <$> stringP c <*> valueP Nothing <*> dictBodyP

    listBodyP = do
      c <- optional P.anyChar
      case c of
        Just 'e' -> return []
        _        -> (:) <$> valueP c <*> listBodyP

    leadingDigit c zeros n0
        | n0==(-10) = d * 10^(fromIntegral (B.length zeros))
        | n0/=0     = d * 10^(fromIntegral (B.length zeros) + truncate (1+logBase 10 (fromIntegral n0))) + n0
        | otherwise = d * 10
      where d = fromIntegral $ ord c - 48

    stringP :: Char -> Parser ByteString
    stringP c = do
      zeros <- P.takeWhile (=='0')
      n0 <- (P.decimal <|> pure (-10)) :: Parser Int
      let n = leadingDigit c zeros n0
      P.char ':'
      P.take n
    {-# INLINE stringP #-}

    integerP :: Parser Integer
    integerP = do
      c <- optional P.anyChar
      case c of
        Just '-' -> do
          negate <$> P.decimal
        Just c'  ->  do zeros <- P.takeWhile (=='0')
                        leadingDigit c' zeros <$> (P.decimal <|> pure (-10))
        _        ->  P.decimal
    {-# INLINE integerP #-}

-- | Try to convert raw bytestring to bencoded value according to
-- specification.
parse :: ByteString -> Either String BValue
parse = P.parseOnly parser

{--------------------------------------------------------------------
  Pretty Printing
--------------------------------------------------------------------}

ppBS :: ByteString -> Doc
ppBS = text . L.map w2c . B.unpack

-- | Convert to easily readable JSON-like document. Typically used for
-- debugging purposes.
ppBEncode :: BValue -> Doc
ppBEncode (BInteger i) = int $ fromIntegral i
ppBEncode (BString  s) = ppBS s
ppBEncode (BList    l)
    = brackets $ hsep $ punctuate comma $ L.map ppBEncode l
ppBEncode (BDict    d)
    = braces $ vcat $ punctuate comma $ L.map ppKV $ BD.toAscList d
  where
    ppKV (k, v) = ppBS k <+> colon <+> ppBEncode v