{-# LANGUAGE CPP                #-}
{-# LANGUAGE RankNTypes         #-}

-- |
-- Module      : Codec.Serialise
-- Copyright   : (c) Duncan Coutts 2015-2017
-- License     : BSD3-style (see LICENSE.txt)
--
-- Maintainer  : [email protected]
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- This module provides functions to serialise and deserialise Haskell
-- values for storage or transmission, to and from lazy
-- @'Data.ByteString.Lazy.ByteString'@s. It also provides a type class
-- and utilities to help you make your types serialisable.
--
-- For a full tutorial on using this module, see
-- "Codec.Serialise.Tutorial".
--
module Codec.Serialise
  ( -- * High level, one-shot API
    -- $highlevel
    serialise
  , deserialise
  , deserialiseOrFail

    -- * Deserialisation exceptions
  , CBOR.Read.DeserialiseFailure(..)

    -- * Incremental encoding interface
    -- $primitives
  , serialiseIncremental
  , deserialiseIncremental
  , CBOR.Read.IDecode(..)

    -- * The @'Serialise'@ class
  , Serialise(..)

    -- * IO operations
    -- | Convenient utilities for basic @'IO'@ operations.

    -- ** @'FilePath'@ API
  , writeFileSerialise
  , readFileDeserialise
    -- ** @'Handle'@ API
  , hPutSerialise
  ) where

import           Control.Monad.ST
import           System.IO                        (Handle, IOMode (..), withFile)
import           Control.Exception                (throw, throwIO)

import qualified Data.ByteString.Builder          as BS
import qualified Data.ByteString.Lazy             as BS
import qualified Data.ByteString.Lazy.Internal    as BS

import           Codec.Serialise.Class
import qualified Codec.CBOR.Read  as CBOR.Read
import qualified Codec.CBOR.Write as CBOR.Write


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

-- $primitives
-- The following API allows you to encode or decode CBOR values incrementally,
-- which is useful for large structures that require you to stream values in
-- over time.
--

-- | Serialise a Haskell value to an external binary representation.
--
-- The output is represented as a 'BS.Builder' and is constructed incrementally.
-- The representation as a 'BS.Builder' allows efficient concatenation with
-- other data.
--
-- @since 0.2.0.0
serialiseIncremental :: Serialise a => a -> BS.Builder
serialiseIncremental :: forall a. Serialise a => a -> Builder
serialiseIncremental = Encoding -> Builder
CBOR.Write.toBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialise a => a -> Encoding
encode

-- | Deserialise a Haskell value from the external binary representation.
--
-- This allows /input/ data to be provided incrementally, rather than all in one
-- go. It also gives an explicit representation of deserialisation errors.
--
-- Note that the incremental behaviour is only for the input data, not the
-- output value: the final deserialised value is constructed and returned as a
-- whole, not incrementally.
--
-- @since 0.2.0.0
deserialiseIncremental :: Serialise a => ST s (CBOR.Read.IDecode s a)
deserialiseIncremental :: forall a s. Serialise a => ST s (IDecode s a)
deserialiseIncremental = forall s a. Decoder s a -> ST s (IDecode s a)
CBOR.Read.deserialiseIncremental forall a s. Serialise a => Decoder s a
decode

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

-- $highlevel
-- The following API exposes a high level interface allowing you to quickly
-- convert between arbitrary Haskell values (which are an instance of
-- @'Serialise'@) and lazy @'BS.ByteString'@s.
--

-- | Serialise a Haskell value to an external binary representation.
--
-- The output is represented as a lazy 'BS.ByteString' and is constructed
-- incrementally.
--
-- @since 0.2.0.0
serialise :: Serialise a => a -> BS.ByteString
serialise :: forall a. Serialise a => a -> ByteString
serialise = Encoding -> ByteString
CBOR.Write.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialise a => a -> Encoding
encode

-- | Deserialise a Haskell value from the external binary representation
-- (which must have been made using 'serialise' or related function).
--
-- /Throws/: @'CBOR.Read.DeserialiseFailure'@ if the given external
-- representation is invalid or does not correspond to a value of the
-- expected type.
--
-- @since 0.2.0.0
deserialise :: Serialise a => BS.ByteString -> a
deserialise :: forall a. Serialise a => ByteString -> a
deserialise ByteString
bs0 =
    forall a. (forall s. ST s a) -> a
runST (forall {s} {a}. ByteString -> IDecode s a -> ST s a
supplyAllInput ByteString
bs0 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a s. Serialise a => ST s (IDecode s a)
deserialiseIncremental)
  where
    supplyAllInput :: ByteString -> IDecode s a -> ST s a
supplyAllInput ByteString
_bs (CBOR.Read.Done ByteString
_ ByteOffset
_ a
x) = forall (m :: * -> *) a. Monad m => a -> m a
return a
x
    supplyAllInput  ByteString
bs (CBOR.Read.Partial Maybe ByteString -> ST s (IDecode s a)
k)  =
      case ByteString
bs of
        BS.Chunk ByteString
chunk ByteString
bs' -> Maybe ByteString -> ST s (IDecode s a)
k (forall a. a -> Maybe a
Just ByteString
chunk) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IDecode s a -> ST s a
supplyAllInput ByteString
bs'
        ByteString
BS.Empty           -> Maybe ByteString -> ST s (IDecode s a)
k forall a. Maybe a
Nothing      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IDecode s a -> ST s a
supplyAllInput ByteString
BS.Empty
    supplyAllInput ByteString
_ (CBOR.Read.Fail ByteString
_ ByteOffset
_ DeserialiseFailure
exn) = forall a e. Exception e => e -> a
throw DeserialiseFailure
exn

-- | Deserialise a Haskell value from the external binary representation,
-- or get back a @'DeserialiseFailure'@.
--
-- @since 0.2.0.0
deserialiseOrFail :: Serialise a => BS.ByteString -> Either CBOR.Read.DeserialiseFailure a
deserialiseOrFail :: forall a. Serialise a => ByteString -> Either DeserialiseFailure a
deserialiseOrFail ByteString
bs0 =
    forall a. (forall s. ST s a) -> a
runST (forall {s} {b}.
ByteString -> IDecode s b -> ST s (Either DeserialiseFailure b)
supplyAllInput ByteString
bs0 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a s. Serialise a => ST s (IDecode s a)
deserialiseIncremental)
  where
    supplyAllInput :: ByteString -> IDecode s b -> ST s (Either DeserialiseFailure b)
supplyAllInput ByteString
_bs (CBOR.Read.Done ByteString
_ ByteOffset
_ b
x) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right b
x)
    supplyAllInput  ByteString
bs (CBOR.Read.Partial Maybe ByteString -> ST s (IDecode s b)
k)  =
      case ByteString
bs of
        BS.Chunk ByteString
chunk ByteString
bs' -> Maybe ByteString -> ST s (IDecode s b)
k (forall a. a -> Maybe a
Just ByteString
chunk) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IDecode s b -> ST s (Either DeserialiseFailure b)
supplyAllInput ByteString
bs'
        ByteString
BS.Empty           -> Maybe ByteString -> ST s (IDecode s b)
k forall a. Maybe a
Nothing      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IDecode s b -> ST s (Either DeserialiseFailure b)
supplyAllInput ByteString
BS.Empty
    supplyAllInput ByteString
_ (CBOR.Read.Fail ByteString
_ ByteOffset
_ DeserialiseFailure
exn) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left DeserialiseFailure
exn)

--------------------------------------------------------------------------------
-- File-based API

-- | Serialise a @'BS.ByteString'@ (via @'serialise'@) and write it directly
-- to the specified @'Handle'@.
--
-- @since 0.2.0.0
hPutSerialise :: Serialise a
              => Handle       -- ^ The @'Handle'@ to write to.
              -> a            -- ^ The value to be serialised and written.
              -> IO ()
hPutSerialise :: forall a. Serialise a => Handle -> a -> IO ()
hPutSerialise Handle
hnd a
x = Handle -> ByteString -> IO ()
BS.hPut Handle
hnd (forall a. Serialise a => a -> ByteString
serialise a
x)

-- | Serialise a @'BS.ByteString'@ and write it directly to the
-- specified file.
--
-- @since 0.2.0.0
writeFileSerialise :: Serialise a
                   => FilePath     -- ^ The file to write to.
                   -> a            -- ^ The value to be serialised and written.
                   -> IO ()
writeFileSerialise :: forall a. Serialise a => FilePath -> a -> IO ()
writeFileSerialise FilePath
fname a
x =
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
fname IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
hnd -> forall a. Serialise a => Handle -> a -> IO ()
hPutSerialise Handle
hnd a
x

-- | Read the specified file (internally, by reading a @'BS.ByteString'@)
-- and attempt to decode it into a Haskell value using @'deserialise'@
-- (the type of which is determined by the choice of the result type).
--
-- /Throws/: @'CBOR.Read.DeserialiseFailure'@ if the file fails to
-- deserialise properly.
--
-- @since 0.2.0.0
readFileDeserialise :: Serialise a
                    => FilePath     -- ^ The file to read from.
                    -> IO a         -- ^ The deserialised value.
readFileDeserialise :: forall a. Serialise a => FilePath -> IO a
readFileDeserialise FilePath
fname =
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
fname IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
hnd -> do
      ByteString
input <- Handle -> IO ByteString
BS.hGetContents Handle
hnd
      case forall a. Serialise a => ByteString -> Either DeserialiseFailure a
deserialiseOrFail ByteString
input of
        Left  DeserialiseFailure
err -> forall e a. Exception e => e -> IO a
throwIO DeserialiseFailure
err
        Right a
x   -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x