module Sound.MED.Basic.AmigaPrivate where

import qualified Sound.MED.Basic.Storable as MedStore
import qualified Sound.MED.Basic.ByteString as MedBytes
import Sound.MED.Basic.Storable (MEM)
import Data.ByteString (ByteString)
import Sound.MED.Basic.Utility (PTR, LONG, ULONG, WORD, UWORD, BYTE, UBYTE)

import qualified Control.Monad.Trans.Class as MT
import qualified Control.Monad.Trans.Reader as MR


type Peek m a = PTR -> m a

class (MonadFail m) => Reader m where
  peekLONG  :: Peek m LONG
  peekULONG :: Peek m ULONG
  peekWORD  :: Peek m WORD
  peekUWORD :: Peek m UWORD
  peekBYTE  :: Peek m BYTE
  peekUBYTE :: Peek m UBYTE

{-# INLINE peekPTR #-}
peekPTR :: (Reader m) => Peek m PTR
peekPTR :: Peek m PTR
peekPTR = Peek m PTR
forall (m :: * -> *). Reader m => Peek m PTR
peekULONG


newtype StorableReader a = StorableReader (MR.ReaderT MEM IO a)

instance Functor StorableReader where
  fmap :: (a -> b) -> StorableReader a -> StorableReader b
fmap a -> b
f (StorableReader ReaderT MEM IO a
act) = ReaderT MEM IO b -> StorableReader b
forall a. ReaderT MEM IO a -> StorableReader a
StorableReader (ReaderT MEM IO b -> StorableReader b)
-> ReaderT MEM IO b -> StorableReader b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> ReaderT MEM IO a -> ReaderT MEM IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ReaderT MEM IO a
act

instance Applicative StorableReader where
  pure :: a -> StorableReader a
pure = ReaderT MEM IO a -> StorableReader a
forall a. ReaderT MEM IO a -> StorableReader a
StorableReader (ReaderT MEM IO a -> StorableReader a)
-> (a -> ReaderT MEM IO a) -> a -> StorableReader a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT MEM IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  StorableReader ReaderT MEM IO (a -> b)
f <*> :: StorableReader (a -> b) -> StorableReader a -> StorableReader b
<*> StorableReader ReaderT MEM IO a
m = ReaderT MEM IO b -> StorableReader b
forall a. ReaderT MEM IO a -> StorableReader a
StorableReader (ReaderT MEM IO (a -> b)
f ReaderT MEM IO (a -> b) -> ReaderT MEM IO a -> ReaderT MEM IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT MEM IO a
m)

instance Monad StorableReader where
  return :: a -> StorableReader a
return = a -> StorableReader a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  StorableReader ReaderT MEM IO a
x >>= :: StorableReader a -> (a -> StorableReader b) -> StorableReader b
>>= a -> StorableReader b
f  =
    ReaderT MEM IO b -> StorableReader b
forall a. ReaderT MEM IO a -> StorableReader a
StorableReader  (ReaderT MEM IO b -> StorableReader b)
-> ReaderT MEM IO b -> StorableReader b
forall a b. (a -> b) -> a -> b
$  ReaderT MEM IO a
x ReaderT MEM IO a -> (a -> ReaderT MEM IO b) -> ReaderT MEM IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> case a -> StorableReader b
f a
a of StorableReader ReaderT MEM IO b
y -> ReaderT MEM IO b
y

instance MonadFail StorableReader where
  fail :: String -> StorableReader a
fail = ReaderT MEM IO a -> StorableReader a
forall a. ReaderT MEM IO a -> StorableReader a
StorableReader (ReaderT MEM IO a -> StorableReader a)
-> (String -> ReaderT MEM IO a) -> String -> StorableReader a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> ReaderT MEM IO a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (IO a -> ReaderT MEM IO a)
-> (String -> IO a) -> String -> ReaderT MEM IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail

runStorable :: StorableReader a -> MEM -> IO a
runStorable :: StorableReader a -> MEM -> IO a
runStorable (StorableReader ReaderT MEM IO a
rd) = ReaderT MEM IO a -> MEM -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
MR.runReaderT ReaderT MEM IO a
rd

{-# INLINE liftStorable #-}
liftStorable :: MedStore.Peek a -> PTR -> StorableReader a
liftStorable :: Peek a -> PTR -> StorableReader a
liftStorable Peek a
peek PTR
ptr = ReaderT MEM IO a -> StorableReader a
forall a. ReaderT MEM IO a -> StorableReader a
StorableReader ((MEM -> IO a) -> ReaderT MEM IO a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
MR.ReaderT ((MEM -> IO a) -> ReaderT MEM IO a)
-> (MEM -> IO a) -> ReaderT MEM IO a
forall a b. (a -> b) -> a -> b
$ \MEM
mem -> Peek a
peek MEM
mem PTR
ptr)

instance Reader StorableReader where
  peekLONG :: Peek StorableReader LONG
peekLONG  = Peek LONG -> Peek StorableReader LONG
forall a. Peek a -> PTR -> StorableReader a
liftStorable Peek LONG
forall a. (Storable a, HasBigEndian a) => Peek a
MedStore.peekBig
  peekULONG :: Peek StorableReader PTR
peekULONG = Peek PTR -> Peek StorableReader PTR
forall a. Peek a -> PTR -> StorableReader a
liftStorable Peek PTR
forall a. (Storable a, HasBigEndian a) => Peek a
MedStore.peekBig
  peekWORD :: Peek StorableReader WORD
peekWORD  = Peek WORD -> Peek StorableReader WORD
forall a. Peek a -> PTR -> StorableReader a
liftStorable Peek WORD
forall a. (Storable a, HasBigEndian a) => Peek a
MedStore.peekBig
  peekUWORD :: Peek StorableReader UWORD
peekUWORD = Peek UWORD -> Peek StorableReader UWORD
forall a. Peek a -> PTR -> StorableReader a
liftStorable Peek UWORD
forall a. (Storable a, HasBigEndian a) => Peek a
MedStore.peekBig
  peekBYTE :: Peek StorableReader BYTE
peekBYTE  = Peek BYTE -> Peek StorableReader BYTE
forall a. Peek a -> PTR -> StorableReader a
liftStorable Peek BYTE
forall a. Storable a => Peek a
MedStore.peekOffset
  peekUBYTE :: Peek StorableReader UBYTE
peekUBYTE = Peek UBYTE -> Peek StorableReader UBYTE
forall a. Peek a -> PTR -> StorableReader a
liftStorable Peek UBYTE
forall a. Storable a => Peek a
MedStore.peekOffset


newtype
  ByteStringReader a =
    ByteStringReader (MR.ReaderT ByteString (Either String) a)

instance Functor ByteStringReader where
  fmap :: (a -> b) -> ByteStringReader a -> ByteStringReader b
fmap a -> b
f (ByteStringReader ReaderT ByteString (Either String) a
act) = ReaderT ByteString (Either String) b -> ByteStringReader b
forall a.
ReaderT ByteString (Either String) a -> ByteStringReader a
ByteStringReader (ReaderT ByteString (Either String) b -> ByteStringReader b)
-> ReaderT ByteString (Either String) b -> ByteStringReader b
forall a b. (a -> b) -> a -> b
$ (a -> b)
-> ReaderT ByteString (Either String) a
-> ReaderT ByteString (Either String) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ReaderT ByteString (Either String) a
act

instance Applicative ByteStringReader where
  pure :: a -> ByteStringReader a
pure = ReaderT ByteString (Either String) a -> ByteStringReader a
forall a.
ReaderT ByteString (Either String) a -> ByteStringReader a
ByteStringReader (ReaderT ByteString (Either String) a -> ByteStringReader a)
-> (a -> ReaderT ByteString (Either String) a)
-> a
-> ByteStringReader a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT ByteString (Either String) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ByteStringReader ReaderT ByteString (Either String) (a -> b)
f <*> :: ByteStringReader (a -> b)
-> ByteStringReader a -> ByteStringReader b
<*> ByteStringReader ReaderT ByteString (Either String) a
m = ReaderT ByteString (Either String) b -> ByteStringReader b
forall a.
ReaderT ByteString (Either String) a -> ByteStringReader a
ByteStringReader (ReaderT ByteString (Either String) (a -> b)
f ReaderT ByteString (Either String) (a -> b)
-> ReaderT ByteString (Either String) a
-> ReaderT ByteString (Either String) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT ByteString (Either String) a
m)

instance Monad ByteStringReader where
  return :: a -> ByteStringReader a
return = a -> ByteStringReader a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ByteStringReader ReaderT ByteString (Either String) a
x >>= :: ByteStringReader a
-> (a -> ByteStringReader b) -> ByteStringReader b
>>= a -> ByteStringReader b
f  =
    ReaderT ByteString (Either String) b -> ByteStringReader b
forall a.
ReaderT ByteString (Either String) a -> ByteStringReader a
ByteStringReader  (ReaderT ByteString (Either String) b -> ByteStringReader b)
-> ReaderT ByteString (Either String) b -> ByteStringReader b
forall a b. (a -> b) -> a -> b
$  ReaderT ByteString (Either String) a
x ReaderT ByteString (Either String) a
-> (a -> ReaderT ByteString (Either String) b)
-> ReaderT ByteString (Either String) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> case a -> ByteStringReader b
f a
a of ByteStringReader ReaderT ByteString (Either String) b
y -> ReaderT ByteString (Either String) b
y

instance MonadFail ByteStringReader where
  fail :: String -> ByteStringReader a
fail = ReaderT ByteString (Either String) a -> ByteStringReader a
forall a.
ReaderT ByteString (Either String) a -> ByteStringReader a
ByteStringReader (ReaderT ByteString (Either String) a -> ByteStringReader a)
-> (String -> ReaderT ByteString (Either String) a)
-> String
-> ByteStringReader a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String a -> ReaderT ByteString (Either String) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (Either String a -> ReaderT ByteString (Either String) a)
-> (String -> Either String a)
-> String
-> ReaderT ByteString (Either String) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left

runByteString :: ByteStringReader a -> ByteString -> Either String a
runByteString :: ByteStringReader a -> ByteString -> Either String a
runByteString (ByteStringReader ReaderT ByteString (Either String) a
rd) = ReaderT ByteString (Either String) a
-> ByteString -> Either String a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
MR.runReaderT ReaderT ByteString (Either String) a
rd

{-# INLINE liftByteString #-}
liftByteString :: MedBytes.Peek a -> PTR -> ByteStringReader a
liftByteString :: Peek a -> PTR -> ByteStringReader a
liftByteString Peek a
peek PTR
ptr =
  ReaderT ByteString (Either String) a -> ByteStringReader a
forall a.
ReaderT ByteString (Either String) a -> ByteStringReader a
ByteStringReader ((ByteString -> Either String a)
-> ReaderT ByteString (Either String) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
MR.ReaderT ((ByteString -> Either String a)
 -> ReaderT ByteString (Either String) a)
-> (ByteString -> Either String a)
-> ReaderT ByteString (Either String) a
forall a b. (a -> b) -> a -> b
$ \ByteString
mem -> a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ Peek a
peek ByteString
mem PTR
ptr)

instance Reader ByteStringReader where
  peekLONG :: Peek ByteStringReader LONG
peekLONG  = Peek LONG -> Peek ByteStringReader LONG
forall a. Peek a -> PTR -> ByteStringReader a
liftByteString Peek LONG
MedBytes.peekInt32
  peekULONG :: Peek ByteStringReader PTR
peekULONG = Peek PTR -> Peek ByteStringReader PTR
forall a. Peek a -> PTR -> ByteStringReader a
liftByteString Peek PTR
MedBytes.peekWord32
  peekWORD :: Peek ByteStringReader WORD
peekWORD  = Peek WORD -> Peek ByteStringReader WORD
forall a. Peek a -> PTR -> ByteStringReader a
liftByteString Peek WORD
MedBytes.peekInt16
  peekUWORD :: Peek ByteStringReader UWORD
peekUWORD = Peek UWORD -> Peek ByteStringReader UWORD
forall a. Peek a -> PTR -> ByteStringReader a
liftByteString Peek UWORD
MedBytes.peekWord16
  peekBYTE :: Peek ByteStringReader BYTE
peekBYTE  = Peek BYTE -> Peek ByteStringReader BYTE
forall a. Peek a -> PTR -> ByteStringReader a
liftByteString Peek BYTE
MedBytes.peekInt8
  peekUBYTE :: Peek ByteStringReader UBYTE
peekUBYTE = Peek UBYTE -> Peek ByteStringReader UBYTE
forall a. Peek a -> PTR -> ByteStringReader a
liftByteString Peek UBYTE
MedBytes.peekWord8