{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- |
-- Conversions from Haskell values to Bencoded @ByteString@s.
--
module Data.Bencode.Encode
  (
    -- * Quick start
    -- $quick

    -- * Encoding
    Encoding
  , toBuilder

    -- * String encoders
  , string
  , text

    -- * Integer encoders
  , integer
  , int
  , int64
  , int32
  , int16
  , int8
  , word
  , word64
  , word32
  , word16
  , word8

    -- * List encoders
  , list

    -- * Dictionary encoders
  , dict
  , field
  , dict'
  , FieldEncodings

    -- * Miscellaneous
  , value

    -- * Recipes #recipes#
    -- $recipes
  ) where

import Data.Int
import Data.Monoid (Endo(..))
import Data.Word
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as BB
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Vector as V

import Data.Bencode.Type (Value(..))

-- | An encoded Bencode value.
newtype Encoding = Encoding { Encoding -> Builder
unEncoding :: BB.Builder }

-- | Get a ByteString 'BB.Builder' representation for an encoded Bencode value.
toBuilder :: Encoding -> BB.Builder
toBuilder :: Encoding -> Builder
toBuilder = Encoding -> Builder
unEncoding

-- | Encode a bytestring as a Bencode string.
string :: B.ByteString -> Encoding
string :: ByteString -> Encoding
string ByteString
s = Builder -> Encoding
Encoding forall a b. (a -> b) -> a -> b
$ Int -> Builder
BB.intDec (ByteString -> Int
B.length ByteString
s) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
':' forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString ByteString
s

-- | Encode an integer as a Bencode integer.
integer :: Integer -> Encoding
integer :: Integer -> Encoding
integer = forall a. (a -> Builder) -> a -> Encoding
integer_ Integer -> Builder
BB.integerDec

-- | Encode a @Vector@ as a Bencode list, using the given encoder for elements.
list :: (a -> Encoding) -> V.Vector a -> Encoding
list :: forall a. (a -> Encoding) -> Vector a -> Encoding
list a -> Encoding
enc Vector a
vs =
  Builder -> Encoding
Encoding forall a b. (a -> b) -> a -> b
$ Char -> Builder
BB.char7 Char
'l' forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Encoding -> Builder
unEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding
enc) Vector a
vs forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
'e'
{-# INLINE list #-}

-- | Encode a @Map@ as a Bencode dictionary, using the given encoder for values.
dict :: (a -> Encoding) -> M.Map B.ByteString a -> Encoding
dict :: forall a. (a -> Encoding) -> Map ByteString a -> Encoding
dict a -> Encoding
enc Map ByteString a
kvs = Builder -> Encoding
Encoding forall a b. (a -> b) -> a -> b
$ Char -> Builder
BB.char7 Char
'd' forall a. Semigroup a => a -> a -> a
<> Map ByteString a -> Builder
f Map ByteString a
kvs forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
'e'
  where
    f :: Map ByteString a -> Builder
f = forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
M.foldMapWithKey (\ByteString
k a
v -> Encoding -> Builder
unEncoding (ByteString -> Encoding
string ByteString
k) forall a. Semigroup a => a -> a -> a
<> Encoding -> Builder
unEncoding (a -> Encoding
enc a
v))
{-# INLINE dict #-}

-- | Encode @Text@ as a Bencode string. As per the Bencode specification, all
-- text must be encoded as UTF-8 strings.
text :: T.Text -> Encoding
text :: Text -> Encoding
text = ByteString -> Encoding
string forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
{-# INLINE text #-}
-- TODO: Check if Text's encodeUtf8Builder is more efficient. But we would
-- also need to know the UTF-8 len, which is only viable for text >= 2.0.

-- | Encode an @Int@ as a Bencode integer.
int :: Int -> Encoding
int :: Int -> Encoding
int = forall a. (a -> Builder) -> a -> Encoding
integer_ Int -> Builder
BB.intDec

-- | Encode a @Word@ as a Bencode integer.
word :: Word -> Encoding
word :: Word -> Encoding
word = forall a. (a -> Builder) -> a -> Encoding
integer_ Word -> Builder
BB.wordDec

-- | A key-value encoding for a Bencode dictionary. Convert to an @Encoding@
-- with 'dict''.
field :: B.ByteString -> (a -> Encoding) -> a -> FieldEncodings
field :: forall a. ByteString -> (a -> Encoding) -> a -> FieldEncodings
field ByteString
k a -> Encoding
enc a
v = Endo [(ByteString, Encoding)] -> FieldEncodings
FE (forall a. (a -> a) -> Endo a
Endo ((ByteString
k, a -> Encoding
enc a
v)forall a. a -> [a] -> [a]
:))
{-# INLINE field #-}

-- | Encode Bencode key-value pairs as a Bencode dictionary.
--
-- __WARNING__: If there are duplicate keys in the @FieldEncodings@, an
-- arbitrary key-value pair among them will be encoded and the rest discarded.
dict' :: FieldEncodings -> Encoding
dict' :: FieldEncodings -> Encoding
dict' = forall a. (a -> Encoding) -> Map ByteString a -> Encoding
dict forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Endo a -> a -> a
appEndo forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldEncodings -> Endo [(ByteString, Encoding)]
unFE
{-# INLINE dict' #-}

-- | Key-value encodings for a Bencode dictionary. See 'field' and 'dict''.
newtype FieldEncodings = FE { FieldEncodings -> Endo [(ByteString, Encoding)]
unFE :: Endo [(B.ByteString, Encoding)] }
  deriving (NonEmpty FieldEncodings -> FieldEncodings
FieldEncodings -> FieldEncodings -> FieldEncodings
forall b. Integral b => b -> FieldEncodings -> FieldEncodings
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> FieldEncodings -> FieldEncodings
$cstimes :: forall b. Integral b => b -> FieldEncodings -> FieldEncodings
sconcat :: NonEmpty FieldEncodings -> FieldEncodings
$csconcat :: NonEmpty FieldEncodings -> FieldEncodings
<> :: FieldEncodings -> FieldEncodings -> FieldEncodings
$c<> :: FieldEncodings -> FieldEncodings -> FieldEncodings
Semigroup, Semigroup FieldEncodings
FieldEncodings
[FieldEncodings] -> FieldEncodings
FieldEncodings -> FieldEncodings -> FieldEncodings
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [FieldEncodings] -> FieldEncodings
$cmconcat :: [FieldEncodings] -> FieldEncodings
mappend :: FieldEncodings -> FieldEncodings -> FieldEncodings
$cmappend :: FieldEncodings -> FieldEncodings -> FieldEncodings
mempty :: FieldEncodings
$cmempty :: FieldEncodings
Monoid)
-- FieldEncodings is not just a type alias because there are multiple ways to
-- do this, and in case the implementation changes it will not be a breaking
-- change.

-- | Encode a @Value@.
value :: Value -> Encoding
value :: Value -> Encoding
value Value
v = case Value
v of
  String ByteString
s  -> ByteString -> Encoding
string ByteString
s
  Integer Integer
i -> Integer -> Encoding
integer Integer
i
  List Vector Value
vs   -> forall a. (a -> Encoding) -> Vector a -> Encoding
list Value -> Encoding
value Vector Value
vs
  Dict Map ByteString Value
vs   -> forall a. (a -> Encoding) -> Map ByteString a -> Encoding
dict Value -> Encoding
value Map ByteString Value
vs

-- | Encode an @Int64@ as a Bencode integer.
--
-- @since 0.1.1.0
int64 :: Int64 -> Encoding
int64 :: Int64 -> Encoding
int64 = forall a. (a -> Builder) -> a -> Encoding
integer_ Int64 -> Builder
BB.int64Dec

-- | Encode an @Int32@ as a Bencode integer.
--
-- @since 0.1.1.0
int32 :: Int32 -> Encoding
int32 :: Int32 -> Encoding
int32 = forall a. (a -> Builder) -> a -> Encoding
integer_ Int32 -> Builder
BB.int32Dec

-- | Encode an @Int16@ as a Bencode integer.
--
-- @since 0.1.1.0
int16 :: Int16 -> Encoding
int16 :: Int16 -> Encoding
int16 = forall a. (a -> Builder) -> a -> Encoding
integer_ Int16 -> Builder
BB.int16Dec

-- | Encode an @Int8@ as a Bencode integer.
--
-- @since 0.1.1.0
int8 :: Int8 -> Encoding
int8 :: Int8 -> Encoding
int8 = forall a. (a -> Builder) -> a -> Encoding
integer_ Int8 -> Builder
BB.int8Dec

-- | Encode a @Word64@ as a Bencode integer.
--
-- @since 0.1.1.0
word64 :: Word64 -> Encoding
word64 :: Word64 -> Encoding
word64 = forall a. (a -> Builder) -> a -> Encoding
integer_ Word64 -> Builder
BB.word64Dec

-- | Encode a @Word32@ as a Bencode integer.
--
-- @since 0.1.1.0
word32 :: Word32 -> Encoding
word32 :: Word32 -> Encoding
word32 = forall a. (a -> Builder) -> a -> Encoding
integer_ Word32 -> Builder
BB.word32Dec

-- | Encode a @Word16@ as a Bencode integer.
--
-- @since 0.1.1.0
word16 :: Word16 -> Encoding
word16 :: Word16 -> Encoding
word16 = forall a. (a -> Builder) -> a -> Encoding
integer_ Word16 -> Builder
BB.word16Dec

-- | Encode a @Word8@ as a Bencode integer.
--
-- @since 0.1.1.0
word8 :: Word8 -> Encoding
word8 :: Word8 -> Encoding
word8 = forall a. (a -> Builder) -> a -> Encoding
integer_ Word8 -> Builder
BB.word8Dec

integer_ :: (a -> BB.Builder) -> a -> Encoding
integer_ :: forall a. (a -> Builder) -> a -> Encoding
integer_ a -> Builder
f = \a
x -> Builder -> Encoding
Encoding forall a b. (a -> b) -> a -> b
$ Char -> Builder
BB.char7 Char
'i' forall a. Semigroup a => a -> a -> a
<> a -> Builder
f a
x forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char7 Char
'e'
{-# INLINE integer_ #-}

------------------------------
-- Documentation
------------------------------

-- $quick
-- Encoding is done using encoders. An encoder is simply a function from a
-- Haskell type to 'Encoding'. This module defines encoders that can be
-- composed to build encoders for arbitrary types.
--
-- @
-- data File = File
--   { hash :: ByteString
--   , size :: Integer
--   , tags :: Vector Text
--   } deriving Show
-- @
--
-- It is reasonable to encode a @File@ as a Bencode dictionary with the field
-- names as keys, and appropriate types for the values.
--
-- @
-- {-# LANGUAGE OverloadedStrings #-}
-- import qualified Data.Bencode.Encode as E
--
-- encodeFile :: File -> E.'Encoding'
-- encodeFile (File hash size tags) = E.'dict'' $
--      E.'field' "hash" E.'string' hash
--   <> E.'field' "size" E.'integer' size
--   <> E.'field' "tags" (E.'list' E.'text') tags
-- @
--
-- Applying 'toBuilder' to an 'Encoding' gives a @ByteString@
-- 'Data.ByteString.Builder', which can then be converted to a lazy
-- @ByteString@, written to a file, or used otherwise.
--
-- @
-- import qualified Data.ByteString.Builder (toLazyByteString)
-- import qualified Data.Vector as V
-- @
--
-- >>> toLazyByteString $ encodeFile $ File "xxxx" 1024 (V.fromList ["work", "backup"])
-- "d4:hash4:xxxx4:sizei1024e4:tagsl4:work6:backupee"
--
-- In this module, encodings are total conversions from Haskell values to
-- @ByteString@s. If some data should fail to encode, it should be handled
-- separately.
--
-- For more examples, see the [Recipes](#g:recipes) section at the end of this
-- page.


-- $recipes
-- Recipes for some common and uncommon usages.
--
-- The following preface is assumed.
--
-- @
-- {-# LANGUAGE OverloadedStrings #-}
-- import Data.ByteString.Builder (toLazyByteString)
-- import Data.Text (Text)
-- import qualified Data.Vector as V
-- import qualified Data.Bencode.Encode as E
--
-- toLBS = toLazyByteString . E.toBuilder
-- @
--
-- === Encode an optional field
--
-- @
-- data File = File { name :: Text, size :: Maybe Int }
--
-- encodeFile :: File -> E.'Encoding'
-- encodeFile (File name size) = E.'dict'' $
--      E.'field' "name" E.'text' name
--   <> 'foldMap' (E.'field' "size" E.'int') size
-- @
--
-- >>> toLBS $ encodeFile $ File "hello.txt" (Just 16)
-- "d4:name9:hello.txt4:sizei16ee"
-- >>> toLBS $ encodeFile $ File "hello.txt" Nothing
-- "d4:name9:hello.txte"
--
-- === Encode an enum
--
-- @
-- data Color = Red | Green | Blue
--
-- encodeColor :: Color -> E.'Encoding'
-- encodeColor = E.'text' . toText
--   where
--     toText Red   = "red"
--     toText Green = "green"
--     toText Blue  = "blue"
-- @
--
-- >>> toLBS $ encodeColor Green
-- "5:green"
--
-- === Encode fields differently based on the value
--
-- @
-- data Response = Response { id_ :: Int, result :: Either Text ByteString }
--
-- encodeResponse :: Response -> E.'Encoding'
-- encodeResponse (Response id_ result) = E.'dict'' $
--      E.'field' "id" E.'int' id_
--   <> either err ok result
--   where
--     err reason =
--          E.'field' "status" E.'text' "failure"
--       <> E.'field' "reason" E.'text' reason
--     ok data_ =
--          E.'field' "status" E.'text' "success"
--       <> E.'field' "data" E.'string' data_
-- @
--
-- >>> toLBS $ encodeResponse $ Response 42 (Left "unauthorized")
-- "d2:idi42e6:reason12:unauthorized6:status7:failuree"
-- >>> toLBS $ encodeResponse $ Response 42 (Right "0000")
-- "d4:data4:00002:idi42e6:status7:successe"
--
-- === Encode as nested dicts
--
-- @
-- data File = File { name :: Text, size :: Int }
--
-- encodeFile :: File -> E.'Encoding'
-- encodeFile (File name size) = E.'dict'' $
--      E.'field' "name" E.'text' name
--   <> E.'field' "metadata" id (E.'dict'' $
--        E.'field' "info" id (E.'dict'' $
--          E.'field' "size" E.'int' size))
-- @
--
-- >>> toLBS $ encodeFile $ File "hello.txt" 32
-- "d8:metadatad4:infod4:sizei32eee4:name9:hello.txte"
--
-- === Encode as a heterogeneous list
--
-- @
-- data File = File { name :: Text, size :: Int }
--
-- encodeFile :: File -> E.'Encoding'
-- encodeFile (File name size) =\
--   E.'list' id $ V.fromList [E.'text' name, E.'int' size]
-- @
--
-- >>> toLBS $ encodeFile $ File "hello.txt" 32
-- "l9:hello.txti32ee"
--