{- |
Parse primitive types contained in MIDI files.
-}
module Sound.MIDI.Parser.Primitive
   (getByte,
    getN, getString, getBigN, getNByteInt,
    get1, get2, get3, get4,
    getNByteCardinal,
    getVar, getVarBytes,
    getEnum, makeEnum, ) where

import qualified Sound.MIDI.Parser.Class as Parser
import Control.Monad (replicateM, liftM, )

import Sound.MIDI.IO (ByteList, listCharFromByte, )
import qualified Sound.MIDI.Bit as Bit
import Data.Bits (testBit, clearBit)
import Data.Word (Word8)
import qualified Numeric.NonNegative.Wrapper as NonNeg



{- |
'getByte' gets a single byte from the input.
-}
getByte :: Parser.C parser => Parser.Fragile parser Word8
getByte :: Fragile parser Word8
getByte = Fragile parser Word8
forall (parser :: * -> *). C parser => Fragile parser Word8
Parser.getByte


{- |
@getN n@ returns n characters (bytes) from the input.
-}
getN :: Parser.C parser => NonNeg.Int -> Parser.Fragile parser ByteList
getN :: Int -> Fragile parser ByteList
getN Int
n = Int
-> ExceptionalT UserMessage parser Word8 -> Fragile parser ByteList
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int -> Int
forall a. T a -> a
NonNeg.toNumber Int
n) ExceptionalT UserMessage parser Word8
forall (parser :: * -> *). C parser => Fragile parser Word8
getByte

getString :: Parser.C parser => NonNeg.Integer -> Parser.Fragile parser String
getString :: Integer -> Fragile parser UserMessage
getString Integer
n = (ByteList -> UserMessage)
-> ExceptionalT UserMessage parser ByteList
-> Fragile parser UserMessage
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteList -> UserMessage
listCharFromByte (Integer -> ExceptionalT UserMessage parser ByteList
forall (parser :: * -> *).
C parser =>
Integer -> Fragile parser ByteList
getBigN Integer
n)

getBigN :: Parser.C parser => NonNeg.Integer -> Parser.Fragile parser ByteList
getBigN :: Integer -> Fragile parser ByteList
getBigN Integer
n =
   [ExceptionalT UserMessage parser Word8] -> Fragile parser ByteList
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([ExceptionalT UserMessage parser Word8]
 -> Fragile parser ByteList)
-> [ExceptionalT UserMessage parser Word8]
-> Fragile parser ByteList
forall a b. (a -> b) -> a -> b
$
   Integer
-> Integer
-> ExceptionalT UserMessage parser Word8
-> [ExceptionalT UserMessage parser Word8]
forall a. Integer -> Integer -> a -> [a]
Bit.replicateBig
      (Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: NonNeg.Int))
      (Integer -> Integer
forall a. T a -> a
NonNeg.toNumber Integer
n)
      ExceptionalT UserMessage parser Word8
forall (parser :: * -> *). C parser => Fragile parser Word8
getByte


{- |
'get1', 'get2', 'get3', and 'get4' take 1-, 2-, 3-, or
4-byte numbers from the input (respectively), convert the base-256 data
into a single number, and return.
-}
get1 :: Parser.C parser => Parser.Fragile parser Int
get1 :: Fragile parser Int
get1 = (Word8 -> Int)
-> ExceptionalT UserMessage parser Word8 -> Fragile parser Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ExceptionalT UserMessage parser Word8
forall (parser :: * -> *). C parser => Fragile parser Word8
getByte

getNByteInt :: Parser.C parser => NonNeg.Int -> Parser.Fragile parser Int
getNByteInt :: Int -> Fragile parser Int
getNByteInt Int
n =
   ([Int] -> Int)
-> ExceptionalT UserMessage parser [Int] -> Fragile parser Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Int] -> Int
forall a. Integral a => [a] -> a
Bit.fromBytes (Int -> Fragile parser Int -> ExceptionalT UserMessage parser [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int -> Int
forall a. T a -> a
NonNeg.toNumber Int
n) Fragile parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get1)

get2, get3, get4 :: Parser.C parser => Parser.Fragile parser Int
get2 :: Fragile parser Int
get2 = Int -> Fragile parser Int
forall (parser :: * -> *). C parser => Int -> Fragile parser Int
getNByteInt Int
2
get3 :: Fragile parser Int
get3 = Int -> Fragile parser Int
forall (parser :: * -> *). C parser => Int -> Fragile parser Int
getNByteInt Int
3
get4 :: Fragile parser Int
get4 = Int -> Fragile parser Int
forall (parser :: * -> *). C parser => Int -> Fragile parser Int
getNByteInt Int
4

getByteAsCardinal :: Parser.C parser => Parser.Fragile parser NonNeg.Integer
getByteAsCardinal :: Fragile parser Integer
getByteAsCardinal = (Word8 -> Integer)
-> ExceptionalT UserMessage parser Word8 -> Fragile parser Integer
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ExceptionalT UserMessage parser Word8
forall (parser :: * -> *). C parser => Fragile parser Word8
getByte

getNByteCardinal :: Parser.C parser => NonNeg.Int -> Parser.Fragile parser NonNeg.Integer
getNByteCardinal :: Int -> Fragile parser Integer
getNByteCardinal Int
n =
   ([Integer] -> Integer)
-> ExceptionalT UserMessage parser [Integer]
-> Fragile parser Integer
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Integer] -> Integer
forall a. Integral a => [a] -> a
Bit.fromBytes (Int
-> Fragile parser Integer
-> ExceptionalT UserMessage parser [Integer]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int -> Int
forall a. T a -> a
NonNeg.toNumber Int
n) Fragile parser Integer
forall (parser :: * -> *). C parser => Fragile parser Integer
getByteAsCardinal)

{- |
/Variable-length quantities/ are used often in MIDI notation.
They are represented in the following way:
Each byte (containing 8 bits) uses the 7 least significant bits to store information.
The most significant bit is used to signal whether or not more information is coming.
If it's @1@, another byte is coming.
If it's @0@, that byte is the last one.
'getVar' gets a variable-length quantity from the input.
-}
getVar :: Parser.C parser => Parser.Fragile parser NonNeg.Integer
getVar :: Fragile parser Integer
getVar =
   (ByteList -> Integer)
-> ExceptionalT UserMessage parser ByteList
-> Fragile parser Integer
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Integer -> [Integer] -> Integer
forall a. Integral a => a -> [a] -> a
Bit.fromBase (Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
7::Int)) ([Integer] -> Integer)
-> (ByteList -> [Integer]) -> ByteList -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Integer) -> ByteList -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ExceptionalT UserMessage parser ByteList
forall (parser :: * -> *). C parser => Fragile parser ByteList
getVarBytes

{- |
The returned list contains only bytes with the most significant bit cleared.
These are digits of a 128-ary number.
-}
getVarBytes :: Parser.C parser => Parser.Fragile parser [Word8]
getVarBytes :: Fragile parser ByteList
getVarBytes =
   do
      Word8
digit <- Fragile parser Word8
forall (parser :: * -> *). C parser => Fragile parser Word8
getByte
      if (Word8 -> Int -> Bool) -> Int -> Word8 -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
7 Word8
digit            -- if it's the last byte
        then (ByteList -> ByteList)
-> Fragile parser ByteList -> Fragile parser ByteList
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Word8 -> Int -> Word8) -> Int -> Word8 -> Word8
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit Int
7 Word8
digit Word8 -> ByteList -> ByteList
forall a. a -> [a] -> [a]
:) Fragile parser ByteList
forall (parser :: * -> *). C parser => Fragile parser ByteList
getVarBytes
        else ByteList -> Fragile parser ByteList
forall (m :: * -> *) a. Monad m => a -> m a
return [Word8
digit]


getEnum :: (Parser.C parser, Enum enum, Bounded enum) => Parser.Fragile parser enum
getEnum :: Fragile parser enum
getEnum = Int -> Fragile parser enum
forall (parser :: * -> *) enum.
(C parser, Enum enum, Bounded enum) =>
Int -> Fragile parser enum
makeEnum (Int -> Fragile parser enum)
-> ExceptionalT UserMessage parser Int -> Fragile parser enum
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExceptionalT UserMessage parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get1

makeEnum :: (Parser.C parser, Enum enum, Bounded enum) => Int -> Parser.Fragile parser enum
makeEnum :: Int -> Fragile parser enum
makeEnum Int
n =
   let go :: (Parser.C parser, Enum a) => a -> a -> Parser.Fragile parser a
       go :: a -> a -> Fragile parser a
go a
lower a
upper =
          if a -> Int
forall a. Enum a => a -> Int
fromEnum a
lower Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Int
forall a. Enum a => a -> Int
fromEnum a
upper
            then a -> Fragile parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> a
forall a. Enum a => Int -> a
toEnum Int
n)
            else UserMessage -> Fragile parser a
forall (m :: * -> *) a. Monad m => UserMessage -> T m a
Parser.giveUp (UserMessage
"value " UserMessage -> UserMessage -> UserMessage
forall a. [a] -> [a] -> [a]
++ Int -> UserMessage
forall a. Show a => a -> UserMessage
show Int
n UserMessage -> UserMessage -> UserMessage
forall a. [a] -> [a] -> [a]
++ UserMessage
" is out of range for enumeration")
   in  enum -> enum -> Fragile parser enum
forall (parser :: * -> *) a.
(C parser, Enum a) =>
a -> a -> Fragile parser a
go enum
forall a. Bounded a => a
minBound enum
forall a. Bounded a => a
maxBound