{-
This module Sound.MIDI.Parser.Stream share significant portions of code.
-}
module Sound.MIDI.Parser.ByteString
   (T(..), run, runIncomplete, {- runPartial, -}
    PossiblyIncomplete, UserMessage, ) where


import qualified Data.ByteString.Lazy as B
import qualified Data.Binary.Get as Binary
import Data.Binary.Get (Get, runGet, )

import Control.Monad.Trans.Class (lift, )
import Control.Monad (liftM, ap, )
import Control.Applicative (Applicative, pure, (<*>), )

import qualified Sound.MIDI.Parser.Report as Report

import qualified Sound.MIDI.Parser.Class as Parser
import Sound.MIDI.Parser.Class (UserMessage, PossiblyIncomplete, )
import qualified Sound.MIDI.Parser.Exception as Exception
import qualified Sound.MIDI.Parser.Warning   as Warning

import Data.Int (Int64)
import qualified Numeric.NonNegative.Wrapper as NonNeg

import Prelude hiding (replicate, until, )



newtype T a = Cons {forall a. T a -> T Get a
decons :: Warning.T Get a}


{-
runPartial :: T a -> B.ByteString -> (Report.T a, B.ByteString)
runPartial parser input =
   flip runGetState input (decons parser)
-}


run :: Parser.Fragile T a -> B.ByteString -> Report.T a
run :: forall a. Fragile T a -> ByteString -> T a
run Fragile T a
parser ByteString
input =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Get a -> ByteString -> a
runGet ByteString
input forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
T m (Exceptional UserMessage a) -> m (T a)
Warning.run forall a b. (a -> b) -> a -> b
$ forall a. T a -> T Get a
decons forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
T m a -> m (Exceptional UserMessage a)
Exception.run forall a b. (a -> b) -> a -> b
$
      (do a
a <- Fragile T a
parser
          forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
             forall (parser :: * -> *). EndCheck parser => parser Bool
Parser.isEnd forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
end ->
                forall (parser :: * -> *).
C parser =>
Bool -> UserMessage -> parser ()
Parser.warnIf (Bool -> Bool
not Bool
end) UserMessage
"unparsed data left over"
          forall (m :: * -> *) a. Monad m => a -> m a
return a
a)

{- |
Treat errors which caused an incomplete data structure as warnings.
This is reasonable, because we do not reveal the remaining unparsed data
and thus further parsing is not possible.
-}
runIncomplete ::
   Parser.Partial (Parser.Fragile T) a -> B.ByteString -> Report.T a
runIncomplete :: forall a.
Partial (ExceptionalT UserMessage T) a -> ByteString -> T a
runIncomplete Partial (ExceptionalT UserMessage T) a
parser ByteString
input =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Fragile T a -> ByteString -> T a
run ByteString
input forall a b. (a -> b) -> a -> b
$
      forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (parser :: * -> *) a.
C parser =>
PossiblyIncomplete a -> parser a
Parser.warnIncomplete forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Partial (ExceptionalT UserMessage T) a
parser


fromGet :: Get a -> T a
fromGet :: forall a. Get a -> T a
fromGet Get a
p =
   forall a. T Get a -> T a
Cons forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Get a
p


instance Functor T where
   fmap :: forall a b. (a -> b) -> T a -> T b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative T where
   pure :: forall a. a -> T a
pure = forall a. T Get a -> T a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
   <*> :: forall a b. T (a -> b) -> T a -> T b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad T where
   return :: forall a. a -> T a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
   T a
x >>= :: forall a b. T a -> (a -> T b) -> T b
>>= a -> T b
y = forall a. T Get a -> T a
Cons forall a b. (a -> b) -> a -> b
$ forall a. T a -> T Get a
decons forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> T b
y forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. T a -> T Get a
decons T a
x


instance Parser.EndCheck T where
   isEnd :: T Bool
isEnd = forall a. Get a -> T a
fromGet Get Bool
Binary.isEmpty

instance Parser.C T where
--   getByte = fromGet Binary.getWord8
-- a get getMaybeWord8 would be nice in order to avoid double-checking
   getByte :: Fragile T Word8
getByte =
      do Bool
end <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Get a -> T a
fromGet Get Bool
Binary.isEmpty
         if Bool
end
           then forall (m :: * -> *) a. Monad m => UserMessage -> T m a
Parser.giveUp UserMessage
"unexpected end of ByteString"
           else forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Get a -> T a
fromGet Get Word8
Binary.getWord8

   skip :: Integer -> ExceptionalT UserMessage T ()
skip Integer
n =
      let toSize :: p -> a
toSize p
x =
            let y :: a
y = if p
x forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound forall a. a -> a -> a
`asTypeOf` a
y)
                      then forall a. HasCallStack => UserMessage -> a
error UserMessage
"skip: number too big"
                      else forall a b. (Integral a, Num b) => a -> b
fromIntegral p
x
            in  a
y
      in  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Get a -> T a
fromGet forall a b. (a -> b) -> a -> b
$ Int64 -> Get ()
skip forall a b. (a -> b) -> a -> b
$ forall {a} {p}. (Bounded a, Integral a, Integral p) => p -> a
toSize forall a b. (a -> b) -> a -> b
$ forall a. T a -> a
NonNeg.toNumber Integer
n

   warn :: UserMessage -> T ()
warn = forall a. T Get a -> T a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Monad m => UserMessage -> T m ()
Warning.warn

{- |
In contrast to Binary.skip this one does not fail badly and it works with Int64.
I hope that it is not too inefficient.
-}
skip :: Int64 -> Get ()
skip :: Int64 -> Get ()
skip Int64
n = Int64 -> Get ByteString
Binary.getLazyByteString Int64
n forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
-- Binary.skip n