{-# LANGUAGE Rank2Types #-}

module Data.Binary.Machine (
  -- * Get
    processGet
  , processGetL
  , streamGet
  , streamGetL
  -- * Put
  , processPut
  -- * Types
  , DecodingError(..)
  ) where

import Data.ByteString (ByteString)
import Data.Binary.Get (Decoder(..), Get, ByteOffset, pushChunk, runGetIncremental)
import Data.Binary.Put (Put, runPut)
import Data.Machine (Plan, ProcessT, Process, auto, repeatedly, yield, echo)
import Data.Machine.Stack (Stack(..), stack, push, pop)

import qualified Data.ByteString.Lazy as Lazy

-- |
-- Construct a Plan that run a 'Get' until it fails or it return a parsed result.
-- This plan automatically manages the pushback of unused input.
--
-- You can use this function to construct a machine and run a 'Get' on the
-- provided input.
-- With 'stack' you can convert the created machine to a normal machine
--
-- @
-- -- construct the machine
-- myMachine :: 'Machine' ('Stack' ByteString) (Either DecodingError Word8)
-- myMachine = 'construct' $ 'processGet' 'getWord8'
--
-- -- run the machine
-- run $ 'stack' ('source' ["abc", "d", "efgh"]) myMachine
-- @
--
-- You can combine machines created in this way with the facilities provided by
-- the machines package.
--
-- @
-- --run m2 after m1
-- myMachine = m1 <> m2
--   where
--     m1 = construct $ processGet (getByteString 5)
--     m2 = construct $ processGet (getByteString 1)
--
-- run $ stack (source ["abc", "d", "efgh"]) myMachine
-- > [Right "abcde",Right "f"]
-- @
processGet :: Get a -> Plan (Stack ByteString) (Either DecodingError a) ()
processGet :: Get a -> Plan (Stack ByteString) (Either DecodingError a) ()
processGet Get a
getA = Get a
-> Plan
     (Stack ByteString)
     (Either DecodingError a)
     (Either DecodingError (ByteOffset, a))
forall a o.
Get a
-> Plan (Stack ByteString) o (Either DecodingError (ByteOffset, a))
_getPlan Get a
getA PlanT
  (Stack ByteString)
  (Either DecodingError a)
  m
  (Either DecodingError (ByteOffset, a))
-> (Either DecodingError (ByteOffset, a)
    -> PlanT
         (Stack ByteString)
         (Either DecodingError a)
         m
         (Either DecodingError a))
-> PlanT
     (Stack ByteString)
     (Either DecodingError a)
     m
     (Either DecodingError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either DecodingError a
-> PlanT
     (Stack ByteString)
     (Either DecodingError a)
     m
     (Either DecodingError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DecodingError a
 -> PlanT
      (Stack ByteString)
      (Either DecodingError a)
      m
      (Either DecodingError a))
-> (Either DecodingError (ByteOffset, a) -> Either DecodingError a)
-> Either DecodingError (ByteOffset, a)
-> PlanT
     (Stack ByteString)
     (Either DecodingError a)
     m
     (Either DecodingError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteOffset, a) -> a)
-> Either DecodingError (ByteOffset, a) -> Either DecodingError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteOffset, a) -> a
forall a b. (a, b) -> b
snd PlanT
  (Stack ByteString)
  (Either DecodingError a)
  m
  (Either DecodingError a)
-> (Either DecodingError a
    -> PlanT (Stack ByteString) (Either DecodingError a) m ())
-> PlanT (Stack ByteString) (Either DecodingError a) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either DecodingError a
-> PlanT (Stack ByteString) (Either DecodingError a) m ()
forall o (k :: * -> *). o -> Plan k o ()
yield

-- | Same as 'processGet' with additional information about the number
-- of bytes consumed by the 'Get'
processGetL :: Get a -> Plan (Stack ByteString) (Either DecodingError (ByteOffset, a)) ()
processGetL :: Get a
-> Plan
     (Stack ByteString) (Either DecodingError (ByteOffset, a)) ()
processGetL Get a
getA = Get a
-> Plan
     (Stack ByteString)
     (Either DecodingError (ByteOffset, a))
     (Either DecodingError (ByteOffset, a))
forall a o.
Get a
-> Plan (Stack ByteString) o (Either DecodingError (ByteOffset, a))
_getPlan Get a
getA PlanT
  (Stack ByteString)
  (Either DecodingError (ByteOffset, a))
  m
  (Either DecodingError (ByteOffset, a))
-> (Either DecodingError (ByteOffset, a)
    -> PlanT
         (Stack ByteString) (Either DecodingError (ByteOffset, a)) m ())
-> PlanT
     (Stack ByteString) (Either DecodingError (ByteOffset, a)) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either DecodingError (ByteOffset, a)
-> PlanT
     (Stack ByteString) (Either DecodingError (ByteOffset, a)) m ()
forall o (k :: * -> *). o -> Plan k o ()
yield

-- | Run a 'Get' multiple times and stream its results
--
-- @
-- run $ source ["abc", "d", "efgh"] ~> streamGet (getByteString 2)
-- > [Right "ab",Right "cd",Right "ef",Right "gh"]
-- @
streamGet :: Get a -> Process ByteString (Either DecodingError a)
streamGet :: Get a -> Process ByteString (Either DecodingError a)
streamGet Get a
getA = MachineT m (Is ByteString) ByteString
-> MachineT m (Stack ByteString) (Either DecodingError a)
-> MachineT m (Is ByteString) (Either DecodingError a)
forall (m :: * -> *) (k :: * -> *) a o.
Monad m =>
MachineT m k a -> MachineT m (Stack a) o -> MachineT m k o
stack MachineT m (Is ByteString) ByteString
forall a. Process a a
echo (PlanT (Stack ByteString) (Either DecodingError a) m ()
-> MachineT m (Stack ByteString) (Either DecodingError a)
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
repeatedly (PlanT (Stack ByteString) (Either DecodingError a) m ()
 -> MachineT m (Stack ByteString) (Either DecodingError a))
-> PlanT (Stack ByteString) (Either DecodingError a) m ()
-> MachineT m (Stack ByteString) (Either DecodingError a)
forall a b. (a -> b) -> a -> b
$ Get a -> Plan (Stack ByteString) (Either DecodingError a) ()
forall a.
Get a -> Plan (Stack ByteString) (Either DecodingError a) ()
processGet Get a
getA)

-- | Same as 'streamGet' with additional information about the number
-- of bytes consumed by the 'Get'
streamGetL :: Get a -> Process ByteString (Either DecodingError (ByteOffset, a))
streamGetL :: Get a -> Process ByteString (Either DecodingError (ByteOffset, a))
streamGetL Get a
getA = MachineT m (Is ByteString) ByteString
-> MachineT
     m (Stack ByteString) (Either DecodingError (ByteOffset, a))
-> MachineT
     m (Is ByteString) (Either DecodingError (ByteOffset, a))
forall (m :: * -> *) (k :: * -> *) a o.
Monad m =>
MachineT m k a -> MachineT m (Stack a) o -> MachineT m k o
stack MachineT m (Is ByteString) ByteString
forall a. Process a a
echo (PlanT
  (Stack ByteString) (Either DecodingError (ByteOffset, a)) m ()
-> MachineT
     m (Stack ByteString) (Either DecodingError (ByteOffset, a))
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
repeatedly (PlanT
   (Stack ByteString) (Either DecodingError (ByteOffset, a)) m ()
 -> MachineT
      m (Stack ByteString) (Either DecodingError (ByteOffset, a)))
-> PlanT
     (Stack ByteString) (Either DecodingError (ByteOffset, a)) m ()
-> MachineT
     m (Stack ByteString) (Either DecodingError (ByteOffset, a))
forall a b. (a -> b) -> a -> b
$ Get a
-> Plan
     (Stack ByteString) (Either DecodingError (ByteOffset, a)) ()
forall a.
Get a
-> Plan
     (Stack ByteString) (Either DecodingError (ByteOffset, a)) ()
processGetL Get a
getA)

-- | Encode evrery input object with a 'Put'
processPut :: Monad m => (a -> Put) -> ProcessT m a ByteString
processPut :: (a -> Put) -> ProcessT m a ByteString
processPut a -> Put
f = (a -> ByteString) -> Process a ByteString
forall (k :: * -> * -> *) a b. Automaton k => k a b -> Process a b
auto ((a -> ByteString) -> Process a ByteString)
-> (a -> ByteString) -> Process a ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Lazy.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
f

-- | A 'Get' decoding error.
data DecodingError = DecodingError
  { DecodingError -> ByteOffset
deConsumed :: {-# UNPACK #-} !ByteOffset
    -- ^ Number of bytes consumed before the error
  , DecodingError -> String
deMessage  :: !String
    -- ^ Error message
  } deriving (Int -> DecodingError -> ShowS
[DecodingError] -> ShowS
DecodingError -> String
(Int -> DecodingError -> ShowS)
-> (DecodingError -> String)
-> ([DecodingError] -> ShowS)
-> Show DecodingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecodingError] -> ShowS
$cshowList :: [DecodingError] -> ShowS
show :: DecodingError -> String
$cshow :: DecodingError -> String
showsPrec :: Int -> DecodingError -> ShowS
$cshowsPrec :: Int -> DecodingError -> ShowS
Show, ReadPrec [DecodingError]
ReadPrec DecodingError
Int -> ReadS DecodingError
ReadS [DecodingError]
(Int -> ReadS DecodingError)
-> ReadS [DecodingError]
-> ReadPrec DecodingError
-> ReadPrec [DecodingError]
-> Read DecodingError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DecodingError]
$creadListPrec :: ReadPrec [DecodingError]
readPrec :: ReadPrec DecodingError
$creadPrec :: ReadPrec DecodingError
readList :: ReadS [DecodingError]
$creadList :: ReadS [DecodingError]
readsPrec :: Int -> ReadS DecodingError
$creadsPrec :: Int -> ReadS DecodingError
Read, DecodingError -> DecodingError -> Bool
(DecodingError -> DecodingError -> Bool)
-> (DecodingError -> DecodingError -> Bool) -> Eq DecodingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecodingError -> DecodingError -> Bool
$c/= :: DecodingError -> DecodingError -> Bool
== :: DecodingError -> DecodingError -> Bool
$c== :: DecodingError -> DecodingError -> Bool
Eq)

--------------------------------------------------------------------------
-- Internals
_decoderPlan :: Decoder a -> Plan (Stack ByteString) o (Either DecodingError (ByteOffset, a))
_decoderPlan :: Decoder a
-> Plan (Stack ByteString) o (Either DecodingError (ByteOffset, a))
_decoderPlan Decoder a
decA = do
  ByteString
xs <- PlanT (Stack ByteString) o m ByteString
forall a b. Plan (Stack a) b a
pop
  case Decoder a -> ByteString -> Decoder a
forall a. Decoder a -> ByteString -> Decoder a
pushChunk Decoder a
decA ByteString
xs of
    Fail ByteString
leftovers ByteOffset
consumed String
e -> ByteString -> Plan (Stack ByteString) o ()
forall a b. a -> Plan (Stack a) b ()
push ByteString
leftovers PlanT (Stack ByteString) o m ()
-> PlanT
     (Stack ByteString) o m (Either DecodingError (ByteOffset, a))
-> PlanT
     (Stack ByteString) o m (Either DecodingError (ByteOffset, a))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either DecodingError (ByteOffset, a)
-> PlanT
     (Stack ByteString) o m (Either DecodingError (ByteOffset, a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DecodingError -> Either DecodingError (ByteOffset, a)
forall a b. a -> Either a b
Left (ByteOffset -> String -> DecodingError
DecodingError ByteOffset
consumed String
e))
    Done ByteString
leftovers ByteOffset
consumed a
a -> ByteString -> Plan (Stack ByteString) o ()
forall a b. a -> Plan (Stack a) b ()
push ByteString
leftovers PlanT (Stack ByteString) o m ()
-> PlanT
     (Stack ByteString) o m (Either DecodingError (ByteOffset, a))
-> PlanT
     (Stack ByteString) o m (Either DecodingError (ByteOffset, a))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either DecodingError (ByteOffset, a)
-> PlanT
     (Stack ByteString) o m (Either DecodingError (ByteOffset, a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteOffset, a) -> Either DecodingError (ByteOffset, a)
forall a b. b -> Either a b
Right (ByteOffset
consumed, a
a))
    Decoder a
decA'                     -> Decoder a
-> Plan (Stack ByteString) o (Either DecodingError (ByteOffset, a))
forall a o.
Decoder a
-> Plan (Stack ByteString) o (Either DecodingError (ByteOffset, a))
_decoderPlan Decoder a
decA'

_getPlan :: Get a -> Plan (Stack ByteString) o (Either DecodingError (ByteOffset, a))
_getPlan :: Get a
-> Plan (Stack ByteString) o (Either DecodingError (ByteOffset, a))
_getPlan Get a
getA = Decoder a
-> Plan (Stack ByteString) o (Either DecodingError (ByteOffset, a))
forall a o.
Decoder a
-> Plan (Stack ByteString) o (Either DecodingError (ByteOffset, a))
_decoderPlan (Decoder a
 -> Plan
      (Stack ByteString) o (Either DecodingError (ByteOffset, a)))
-> Decoder a
-> Plan (Stack ByteString) o (Either DecodingError (ByteOffset, a))
forall a b. (a -> b) -> a -> b
$ Get a -> Decoder a
forall a. Get a -> Decoder a
runGetIncremental Get a
getA
--------------------------------------------------------------------------