{- |
Parser which limits the input data to a given number of bytes.
We need this for parsing MIDI tracks and some MetaEvents,
where the length of a part is fixed by a length specification.
-}
module Sound.MIDI.Parser.Restricted
   (T(..), run, runFragile, ) where

import qualified Sound.MIDI.Parser.Class as Parser

import qualified Control.Monad.Exception.Synchronous  as Sync
import qualified Control.Monad.Trans.Class as Trans
import Control.Monad.Trans.State (StateT(runStateT), gets, get, put, )
import Control.Monad (when, )
import Control.Applicative (Applicative, pure, (<*>), )

import qualified Numeric.NonNegative.Wrapper as NonNeg

import Prelude hiding (replicate, until, )


run :: Parser.C parser =>
   NonNeg.Integer -> T parser a -> parser a
run :: forall (parser :: * -> *) a.
C parser =>
Integer -> T parser a -> parser a
run Integer
maxLen T parser a
p =
   do (a
x,Integer
remaining) <- forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall (parser :: * -> *) a. T parser a -> StateT Integer parser a
decons T parser a
p) Integer
maxLen
      forall (parser :: * -> *).
C parser =>
Bool -> UserMessage -> parser ()
Parser.warnIf
         (Integer
remainingforall a. Ord a => a -> a -> Bool
>Integer
0)
         (UserMessage
"unparsed bytes left in part (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> UserMessage
show Integer
remaining forall a. [a] -> [a] -> [a]
++ UserMessage
" bytes)")
      forall (m :: * -> *) a. Monad m => a -> m a
return a
x

runFragile :: Parser.C parser =>
   NonNeg.Integer -> Parser.Fragile (T parser) a -> Parser.Fragile parser a
runFragile :: forall (parser :: * -> *) a.
C parser =>
Integer -> Fragile (T parser) a -> Fragile parser a
runFragile Integer
len = forall (m :: * -> *) e0 a (n :: * -> *) e1 b.
(m (Exceptional e0 a) -> n (Exceptional e1 b))
-> ExceptionalT e0 m a -> ExceptionalT e1 n b
Sync.mapExceptionalT (forall (parser :: * -> *) a.
C parser =>
Integer -> T parser a -> parser a
run Integer
len)


lift :: Monad parser => Parser.Fragile parser a -> Parser.Fragile (T parser) a
lift :: forall (parser :: * -> *) a.
Monad parser =>
Fragile parser a -> Fragile (T parser) a
lift = forall (m :: * -> *) e0 a (n :: * -> *) e1 b.
(m (Exceptional e0 a) -> n (Exceptional e1 b))
-> ExceptionalT e0 m a -> ExceptionalT e1 n b
Sync.mapExceptionalT forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift



newtype T parser a =
   Cons {forall (parser :: * -> *) a. T parser a -> StateT Integer parser a
decons :: StateT NonNeg.Integer parser a}

instance Functor parser => Functor (T parser) where
   fmap :: forall a b. (a -> b) -> T parser a -> T parser b
fmap a -> b
f = forall (parser :: * -> *) a. StateT Integer parser a -> T parser a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (parser :: * -> *) a. T parser a -> StateT Integer parser a
decons

instance (Applicative parser, Monad parser) => Applicative (T parser) where
   pure :: forall a. a -> T parser a
pure = forall (parser :: * -> *) a. StateT Integer parser a -> T parser a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
   Cons StateT Integer parser (a -> b)
f <*> :: forall a b. T parser (a -> b) -> T parser a -> T parser b
<*> Cons StateT Integer parser a
a = forall (parser :: * -> *) a. StateT Integer parser a -> T parser a
Cons forall a b. (a -> b) -> a -> b
$ StateT Integer parser (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Integer parser a
a

instance Monad parser => Monad (T parser) where
   return :: forall a. a -> T parser a
return = forall (parser :: * -> *) a. StateT Integer parser a -> T parser a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
   T parser a
x >>= :: forall a b. T parser a -> (a -> T parser b) -> T parser b
>>= a -> T parser b
y = forall (parser :: * -> *) a. StateT Integer parser a -> T parser a
Cons forall a b. (a -> b) -> a -> b
$ forall (parser :: * -> *) a. T parser a -> StateT Integer parser a
decons forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> T parser b
y forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (parser :: * -> *) a. T parser a -> StateT Integer parser a
decons T parser a
x

instance Trans.MonadTrans T where
   lift :: forall (m :: * -> *) a. Monad m => m a -> T m a
lift = forall (parser :: * -> *) a. StateT Integer parser a -> T parser a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift


getRemaining :: Monad parser => Parser.Fragile (T parser) NonNeg.Integer
getRemaining :: forall (parser :: * -> *).
Monad parser =>
Fragile (T parser) Integer
getRemaining = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall a b. (a -> b) -> a -> b
$ forall (parser :: * -> *) a. StateT Integer parser a -> T parser a
Cons forall (m :: * -> *) s. Monad m => StateT s m s
get

putRemaining :: Monad parser => NonNeg.Integer -> Parser.Fragile (T parser) ()
putRemaining :: forall (parser :: * -> *).
Monad parser =>
Integer -> Fragile (T parser) ()
putRemaining = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (parser :: * -> *) a. StateT Integer parser a -> T parser a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put


instance Parser.EndCheck parser => Parser.EndCheck (T parser) where
   isEnd :: T parser Bool
isEnd =
     {- if remaining>0 then we do not check
        whether there are actually more bytes in the stream
        because that will be catched anyway on the next getByte or skip -}
     forall (parser :: * -> *) a. StateT Integer parser a -> T parser a
Cons (forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (Integer
0forall a. Eq a => a -> a -> Bool
==))
--       if remaining==0 then return True else lift Parser.isEnd

instance Parser.C parser => Parser.C (T parser) where
   getByte :: Fragile (T parser) Word8
getByte =
     forall (parser :: * -> *).
Monad parser =>
Fragile (T parser) Integer
getRemaining forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
remaining ->
       do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
remainingforall a. Eq a => a -> a -> Bool
==Integer
0)
             (forall (parser :: * -> *) a.
Monad parser =>
Fragile parser a -> Fragile (T parser) a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => UserMessage -> T m a
Parser.giveUp UserMessage
"unexpected end of part")
{- in principle not necessary, because Parser.getByte must check for remaining bytes
          end <- lift Parser.isEnd
          when end
             (lift $ Parser.giveUp "part longer than container")
-}
          forall (parser :: * -> *).
Monad parser =>
Integer -> Fragile (T parser) ()
putRemaining (Integer
remainingforall a. Num a => a -> a -> a
-Integer
1)
          forall (parser :: * -> *) a.
Monad parser =>
Fragile parser a -> Fragile (T parser) a
lift forall (parser :: * -> *). C parser => Fragile parser Word8
Parser.getByte

   skip :: Integer -> Fragile (T parser) ()
skip Integer
n =
     forall (parser :: * -> *).
Monad parser =>
Fragile (T parser) Integer
getRemaining forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
remaining ->
       if Integer
nforall a. Ord a => a -> a -> Bool
>Integer
remaining
         then forall (parser :: * -> *) a.
Monad parser =>
Fragile parser a -> Fragile (T parser) a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => UserMessage -> T m a
Parser.giveUp UserMessage
"skip beyond end of part"
         else forall (parser :: * -> *).
Monad parser =>
Integer -> Fragile (T parser) ()
putRemaining (Integer
remainingforall a. Num a => a -> a -> a
-Integer
n) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              forall (parser :: * -> *) a.
Monad parser =>
Fragile parser a -> Fragile (T parser) a
lift (forall (parser :: * -> *). C parser => Integer -> Fragile parser ()
Parser.skip Integer
n)

   warn :: UserMessage -> T parser ()
warn = forall (parser :: * -> *) a. StateT Integer parser a -> T parser a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (parser :: * -> *). C parser => UserMessage -> parser ()
Parser.warn