{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Read and write values of types that implement 'Binary.Binary' from and to 'Handle's
--
-- This module homes the unlifted API variant. For proper documentation check out the equally named
-- functions in "Data.Binary.IO.Lifted"
--
module Data.Binary.IO
  ( -- * Reader
    Lifted.ReaderError (..)

  , Reader (..)
  , newReader
  , newReaderWith

    -- * Writer
  , Writer (..)
  , newWriter
  , newWriterWith

    -- * Pipe
  , newPipe

    -- * Duplex
  , Duplex (..)
  , newDuplex
  , newDuplexWith

    -- * Classes
  , CanGet
  , runGet
  , read
  , isEmpty

  , CanPut
  , runPut
  , write
  )
where

import           Data.Bifunctor (bimap)
import qualified Data.Binary as Binary
import qualified Data.Binary.IO.Lifted as Lifted
import qualified Data.Binary.Put as Put
import qualified Data.ByteString as ByteString
import           Prelude hiding (read)
import           System.IO (Handle)

-- * Reader

-- | Alias for 'Lifted.Reader' 'IO'
--
-- @since 0.0.1
newtype Reader = Reader
  { Reader -> Reader IO
unReader :: Lifted.Reader IO }

instance Lifted.CanGet Reader IO where
  runGet :: Reader -> Get a -> IO a
runGet = Reader IO -> Get a -> IO a
forall r a. CanGet r => r -> Get a -> IO a
runGet (Reader IO -> Get a -> IO a)
-> (Reader -> Reader IO) -> Reader -> Get a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader -> Reader IO
unReader

-- | Unlifted version of 'Lifted.newReader'
--
-- @since 0.0.1
newReader
  :: Handle -- ^ Handle that will be read from
  -> IO Reader
newReader :: Handle -> IO Reader
newReader Handle
handle =
  Reader IO -> Reader
Reader (Reader IO -> Reader) -> IO (Reader IO) -> IO Reader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO (Reader IO)
forall (m :: * -> *).
(MonadConc m, MonadIO m) =>
Handle -> m (Reader m)
Lifted.newReader Handle
handle

-- | Unlifted version of 'Lifted.newReaderWith'.
--
-- @since 0.1.1
newReaderWith
  :: IO ByteString.ByteString -- ^ Chunk producer
  -> IO Reader
newReaderWith :: IO ByteString -> IO Reader
newReaderWith IO ByteString
get =
  Reader IO -> Reader
Reader (Reader IO -> Reader) -> IO (Reader IO) -> IO Reader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString -> IO (Reader IO)
forall (m :: * -> *). MonadConc m => m ByteString -> m (Reader m)
Lifted.newReaderWith IO ByteString
get

-- * Writer

-- | @since 0.0.1
newtype Writer = Writer
  { Writer -> Writer IO
unWriter :: Lifted.Writer IO }

instance Lifted.CanPut Writer IO where
  runPut :: Writer -> PutM a -> IO a
runPut = Writer IO -> PutM a -> IO a
forall w a. CanPut w => w -> PutM a -> IO a
runPut (Writer IO -> PutM a -> IO a)
-> (Writer -> Writer IO) -> Writer -> PutM a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer -> Writer IO
unWriter

-- | Unlifted version of 'Lifted.newWriter'
--
-- @since 0.0.1
newWriter
  :: Handle -- ^ Handle that will be written to
  -> Writer
newWriter :: Handle -> Writer
newWriter =
  Writer IO -> Writer
Writer (Writer IO -> Writer) -> (Handle -> Writer IO) -> Handle -> Writer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Writer IO
forall (m :: * -> *). MonadIO m => Handle -> Writer m
Lifted.newWriter

-- | Unlifted version of 'Lifted.newWriterWith'
--
-- @since 0.1.1
newWriterWith
  :: (ByteString.ByteString -> IO ()) -- ^ Chunk handler
  -> Writer
newWriterWith :: (ByteString -> IO ()) -> Writer
newWriterWith =
  Writer IO -> Writer
Writer (Writer IO -> Writer)
-> ((ByteString -> IO ()) -> Writer IO)
-> (ByteString -> IO ())
-> Writer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> IO ()) -> Writer IO
forall (m :: * -> *). Functor m => (ByteString -> m ()) -> Writer m
Lifted.newWriterWith

-- * Pipe

-- | Unlifted version of 'Lifted.newPipe'
--
-- @since 0.2.0
newPipe :: IO (Reader, Writer)
newPipe :: IO (Reader, Writer)
newPipe = (Reader IO -> Reader)
-> (Writer IO -> Writer)
-> (Reader IO, Writer IO)
-> (Reader, Writer)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Reader IO -> Reader
Reader Writer IO -> Writer
Writer ((Reader IO, Writer IO) -> (Reader, Writer))
-> IO (Reader IO, Writer IO) -> IO (Reader, Writer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Reader IO, Writer IO)
forall (m :: * -> *).
(MonadConc m, MonadIO m) =>
m (Reader m, Writer m)
Lifted.newPipe

-- * Duplex

-- | @since 0.0.1
data Duplex = Duplex
  { Duplex -> Writer
duplexWriter :: !Writer
  , Duplex -> Reader
duplexReader :: !Reader
  }

instance Lifted.CanGet Duplex IO where
  runGet :: Duplex -> Get a -> IO a
runGet = Reader -> Get a -> IO a
forall r a. CanGet r => r -> Get a -> IO a
runGet (Reader -> Get a -> IO a)
-> (Duplex -> Reader) -> Duplex -> Get a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duplex -> Reader
duplexReader

instance Lifted.CanPut Duplex IO where
  runPut :: Duplex -> PutM a -> IO a
runPut = Writer -> PutM a -> IO a
forall w a. CanPut w => w -> PutM a -> IO a
runPut (Writer -> PutM a -> IO a)
-> (Duplex -> Writer) -> Duplex -> PutM a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duplex -> Writer
duplexWriter

-- | Unlifted version of 'Lifted.newDuplex'
--
-- @since 0.0.1
newDuplex
  :: Handle -- ^ Handle that will be read from and written to
  -> IO Duplex
newDuplex :: Handle -> IO Duplex
newDuplex Handle
handle = do
  Lifted.Duplex Writer IO
writer Reader IO
reader <- Handle -> IO (Duplex IO)
forall (m :: * -> *).
(MonadConc m, MonadIO m) =>
Handle -> m (Duplex m)
Lifted.newDuplex Handle
handle
  Duplex -> IO Duplex
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Writer -> Reader -> Duplex
Duplex (Writer IO -> Writer
Writer Writer IO
writer) (Reader IO -> Reader
Reader Reader IO
reader))

-- | Unlifted version of 'Lifted.newDuplexWith'
--
-- @since 0.1.1
newDuplexWith
  :: IO ByteString.ByteString
  -> (ByteString.ByteString -> IO ())
  -> IO Duplex
newDuplexWith :: IO ByteString -> (ByteString -> IO ()) -> IO Duplex
newDuplexWith IO ByteString
get ByteString -> IO ()
push = do
  Lifted.Duplex Writer IO
writer Reader IO
reader <- IO ByteString -> (ByteString -> IO ()) -> IO (Duplex IO)
forall (m :: * -> *).
MonadConc m =>
m ByteString -> (ByteString -> m ()) -> m (Duplex m)
Lifted.newDuplexWith IO ByteString
get ByteString -> IO ()
push
  Duplex -> IO Duplex
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Writer -> Reader -> Duplex
Duplex (Writer IO -> Writer
Writer Writer IO
writer) (Reader IO -> Reader
Reader Reader IO
reader))

-- * Classes

-- | Alias for 'Lifted.CanGet' @r@ 'IO'
--
-- @since 0.0.1
type CanGet r = Lifted.CanGet r IO

-- | Unlifted version of 'Lifted.runGet'
--
-- @since 0.0.1
runGet
  :: CanGet r
  => r -- ^ Reader / source
  -> Binary.Get a -- ^ Operation to execute
  -> IO a
runGet :: r -> Get a -> IO a
runGet =
  r -> Get a -> IO a
forall r (m :: * -> *) a. CanGet r m => r -> Get a -> m a
Lifted.runGet

-- | Unlifted version of 'Lifted.read'
--
-- @since 0.0.1
read
  :: (CanGet r, Binary.Binary a)
  => r -- ^ Read source
  -> IO a
read :: r -> IO a
read =
  r -> IO a
forall r (m :: * -> *) a. (CanGet r m, Binary a) => r -> m a
Lifted.read

-- | Unlifted version of 'Lifted.isEmpty'
--
-- @since 0.3.0
isEmpty :: CanGet r => r -> IO Bool
isEmpty :: r -> IO Bool
isEmpty = r -> IO Bool
forall r (m :: * -> *). CanGet r m => r -> m Bool
Lifted.isEmpty

-- | Alias for 'Lifted.CanPut' @w@ 'IO'
--
-- @since 0.0.1
type CanPut w = Lifted.CanPut w IO

-- | Unlifted version of 'Lifted.runPut'
--
-- @since 0.0.1
runPut
  :: CanPut w
  => w -- ^ Writer / target
  -> Put.PutM a -- ^ Operation to execute
  -> IO a
runPut :: w -> PutM a -> IO a
runPut =
  w -> PutM a -> IO a
forall w (m :: * -> *) a. CanPut w m => w -> PutM a -> m a
Lifted.runPut

-- | Unlifted version of 'Lifted.write'
--
-- @since 0.0.1
write
  :: (CanPut w, Binary.Binary a)
  => w -- ^ Write target
  -> a -- ^ Value to be written
  -> IO ()
write :: w -> a -> IO ()
write =
  w -> a -> IO ()
forall w (m :: * -> *) a. (CanPut w m, Binary a) => w -> a -> m ()
Lifted.write