{-# OPTIONS_HADDOCK hide       #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts  #-}

-- | Internal module that has the encode class and some utility functions.
module Raaz.Core.Encode.Internal
       ( Encodable(..), Format(..)
       ) where

import Data.Maybe

import           Data.ByteString              (ByteString)
import           Data.ByteString.Internal     (unsafeCreate)
import           Data.String
import           Data.Word
import           Foreign.Ptr
import Prelude hiding               (length)
import System.IO.Unsafe   (unsafePerformIO)

import Raaz.Core.Types.Endian
import Raaz.Core.Types.Pointer
import Raaz.Core.Util.ByteString(length, withByteString)


-- | The type class `Encodable` captures all the types that can be
-- encoded into a stream of bytes. For a user defined type say @Foo@,
-- defining an instance `Encodable` is all that is required to make
-- use of `encode` and `decode` for any of the supported encoding
-- formats (i.e. instances of the class `Format`).
--
-- Minimum complete definition for this class is `toByteString` and
-- `fromByteString`. Instances of `EndianStore` have default
-- definitions for both these functions and hence a trivial instance
-- declaration is sufficient for such types.
--
-- > newtype Foo = Foo (LE Word64) deriving (Storable, EndianStore)
-- >
-- > instance EndianStore Foo where
-- >   ...
-- >
-- > instance Encodable Foo
-- >
--
-- In particular, all the endian encoded versions of Haskell's word,
-- i.e types like @`LE` Word32@, @`LE` Word64@ etc, are instances of
-- `Encodable`. Note that the corresponding plain type is /not/ an
-- instance of `Encodable` because encoding of say `Word32` without
-- specifying whether the endianness is meaningless.
--
-- === Laws for encoding
--
-- Note that not all byte strings can be valid encodings and
-- `fromByteString` might fail and return `Nothing` on certain
-- inputs. However, we require the minimum guarantee that
-- `fromByteString` for actual encodings of elements, i.e. we require
-- the instances to satisfy the law.
--
-- > fromByteString . toByteString = Just
--
-- TODO: Write test cases for encoding laws.

class Encodable a where
  -- | Convert stuff to bytestring
  toByteString          :: a           -> ByteString

  -- | Try parsing back a value. Returns nothing on failure.
  fromByteString        :: ByteString  -> Maybe a

  -- | Unsafe version of `fromByteString`
  unsafeFromByteString  :: ByteString  -> a

  default toByteString :: EndianStore a => a -> ByteString
  toByteString a
w    = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate (BYTES Int -> Int
forall a. Enum a => a -> Int
fromEnum (BYTES Int -> Int) -> BYTES Int -> Int
forall a b. (a -> b) -> a -> b
$ Proxy a -> BYTES Int
forall a. Storable a => Proxy a -> BYTES Int
sizeOf (a -> Proxy a
forall a. a -> Proxy a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
w)) Ptr Word8 -> IO ()
forall {a}. Ptr a -> IO ()
putit
    where putit :: Ptr a -> IO ()
putit Ptr a
ptr = Ptr a -> a -> IO ()
forall w. EndianStore w => Ptr w -> w -> IO ()
store (Ptr a -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) a
w


  default fromByteString :: EndianStore a => ByteString -> Maybe a
  fromByteString ByteString
bs  | Proxy a -> BYTES Int
forall a. Storable a => Proxy a -> BYTES Int
sizeOf Proxy a
proxy BYTES Int -> BYTES Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> BYTES Int
length ByteString
bs   = a -> Maybe a
forall a. a -> Maybe a
Just a
w
                     | Bool
otherwise                   = Maybe a
forall a. Maybe a
Nothing
         where w :: a
w     = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> (Ptr Any -> IO a) -> IO a
forall something a. ByteString -> (Ptr something -> IO a) -> IO a
withByteString ByteString
bs (Ptr a -> IO a
forall w. EndianStore w => Ptr w -> IO w
load (Ptr a -> IO a) -> (Ptr Any -> Ptr a) -> Ptr Any -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Any -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr)
               proxy :: Proxy a
proxy = a -> Proxy a
forall a. a -> Proxy a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
w

  unsafeFromByteString = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"fromByteString error") (Maybe a -> a) -> (ByteString -> Maybe a) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe a
forall a. Encodable a => ByteString -> Maybe a
fromByteString

instance Encodable Word8
instance Encodable (LE Word32)
instance Encodable (LE Word64)
instance Encodable (BE Word32)
instance Encodable (BE Word64)
instance Encodable ()

instance Encodable ByteString where
  toByteString :: ByteString -> ByteString
toByteString         = ByteString -> ByteString
forall a. a -> a
id
  {-# INLINE toByteString #-}
  fromByteString :: ByteString -> Maybe ByteString
fromByteString       = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just
  {-# INLINE fromByteString #-}
  unsafeFromByteString :: ByteString -> ByteString
unsafeFromByteString = ByteString -> ByteString
forall a. a -> a
id
  {-# INLINE unsafeFromByteString #-}

instance Encodable a => Encodable (BYTES a) where
  toByteString :: BYTES a -> ByteString
toByteString         (BYTES a
a) = a -> ByteString
forall a. Encodable a => a -> ByteString
toByteString a
a
  fromByteString :: ByteString -> Maybe (BYTES a)
fromByteString        = (a -> BYTES a) -> Maybe a -> Maybe (BYTES a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> BYTES a
forall a. a -> BYTES a
BYTES (Maybe a -> Maybe (BYTES a))
-> (ByteString -> Maybe a) -> ByteString -> Maybe (BYTES a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe a
forall a. Encodable a => ByteString -> Maybe a
fromByteString
  unsafeFromByteString :: ByteString -> BYTES a
unsafeFromByteString  = a -> BYTES a
forall a. a -> BYTES a
BYTES      (a -> BYTES a) -> (ByteString -> a) -> ByteString -> BYTES a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> a
forall a. Encodable a => ByteString -> a
unsafeFromByteString



-- | A binary format is a representation of binary data often in
-- printable form. We distinguish between various binary formats at
-- the type level and each supported format corresponds to an instance
-- of the the class `Format`. The `encodeByteString` and
-- `decodeFormat` are required to satisfy the laws
--
-- > decodeFormat . encodeByteString = id
--
-- For type safety, the formats themselves are opaque types and hence
-- it is not possible to obtain the underlying binary data directly.
-- We require binary formats to be instances of the class `Encodable`,
-- with the combinators `toByteString` and `fromByteString` of the
-- `Encodable` class performing the actual encoding and decoding.
--
-- Instances of `Format` are required to be instances of `Show` and so
-- that the encoded format can be easily printed. They are also
-- required to be instances of `IsString` so that they can be easily
-- represented in Haskell source using the @OverloadedStrings@
-- extension.  However, be careful when using this due to the fact
-- that invalid encodings can lead to runtime errors.
--
class (IsString fmt, Show fmt, Encodable fmt) => Format fmt where

  -- | Encode binary data into the format. The return type gurantees
  -- that any binary data can indeed be encoded into a format.
  encodeByteString :: ByteString -> fmt

  -- | Decode the format to its associated binary
  -- representation. Notice that this function always succeeds: we
  -- assume that elements of the type `fmt` are valid encodings and
  -- hence the return type is `ByteString` instead of @`Maybe`
  -- ByteString@.
  decodeFormat     :: fmt        -> ByteString

-- | Bytestring itself is an encoding format (namely binary format).
instance Format ByteString where
  encodeByteString :: ByteString -> ByteString
encodeByteString = ByteString -> ByteString
forall a. a -> a
id
  {-# INLINE encodeByteString #-}
  decodeFormat :: ByteString -> ByteString
decodeFormat     = ByteString -> ByteString
forall a. a -> a
id
  {-# INLINE decodeFormat     #-}