med-module 0.1.1 → 0.1.2
raw patch · 4 files changed
+201/−93 lines, 4 filesdep ~base
Dependency ranges changed: base
Files
- med-module.cabal +12/−6
- src-fail/before-4.13/Sound/MED/Basic/AmigaPrivate.hs +91/−0
- src-fail/from-4.13/Sound/MED/Basic/AmigaPrivate.hs +94/−0
- src/Sound/MED/Basic/Amiga.hs +4/−87
med-module.cabal view
@@ -1,5 +1,5 @@ Name: med-module-Version: 0.1.1+Version: 0.1.2 Synopsis: Parse song module files from Amiga MED and OctaMED Description: MED (Music EDitor) and its successor OctaMED@@ -29,7 +29,7 @@ Cabal-Version: >=1.10 Source-Repository this- Tag: 0.1.1+ Tag: 0.1.2 Type: darcs Location: http://hub.darcs.net/thielema/med-module @@ -81,18 +81,24 @@ Sound.MED.Generic.PlaySeq Sound.MED.Generic.Tempo Other-Modules:+ Sound.MED.Basic.AmigaPrivate Sound.MED.Basic.Pretty Sound.MED.Basic.Storable Sound.MED.Basic.ByteString Sound.MED.Basic.Utility + Hs-Source-Dirs: src Build-Depends: transformers >=0.3 && <0.6, storable-endian >=0.2.6 && <0.3, bytestring >=0.9.2 && <0.11,- utility-ht >=0.0.12 && <0.1,- base >=4.5 && <5- Hs-Source-Dirs: src+ utility-ht >=0.0.12 && <0.1+ If impl(ghc<8.8)+ Hs-Source-Dirs: src-fail/before-4.13+ Build-Depends: base >=4.5 && <4.13+ Else+ Hs-Source-Dirs: src-fail/from-4.13+ Build-Depends: base >=4.13 && <5 Default-Language: Haskell2010 GHC-Options: -Wall -fwarn-incomplete-uni-patterns -fwarn-tabs @@ -117,7 +123,7 @@ Build-Depends: med-module, hps >=0.15 && <0.16,- optparse-applicative >=0.11 && <0.15,+ optparse-applicative >=0.11 && <0.16, filepath >=1.3 && <1.5, array >=0.4 && <0.6, transformers >=0.3 && <0.6,
+ src-fail/before-4.13/Sound/MED/Basic/AmigaPrivate.hs view
@@ -0,0 +1,91 @@+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+import Control.Applicative (Applicative(pure, (<*>)))+++type Peek m a = PTR -> m a++class (Monad 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 = peekULONG+++newtype StorableReader a = StorableReader (MR.ReaderT MEM IO a)++instance Functor StorableReader where+ fmap f (StorableReader act) = StorableReader $ fmap f act++instance Applicative StorableReader where+ pure = StorableReader . pure+ StorableReader f <*> StorableReader m = StorableReader (f <*> m)++instance Monad StorableReader where+ return = pure+ StorableReader x >>= f =+ StorableReader $ x >>= \a -> case f a of StorableReader y -> y+ fail = StorableReader . MT.lift . fail++runStorable :: StorableReader a -> MEM -> IO a+runStorable (StorableReader rd) = MR.runReaderT rd++{-# INLINE liftStorable #-}+liftStorable :: MedStore.Peek a -> PTR -> StorableReader a+liftStorable peek ptr = StorableReader (MR.ReaderT $ \mem -> peek mem ptr)++instance Reader StorableReader where+ peekLONG = liftStorable MedStore.peekBig+ peekULONG = liftStorable MedStore.peekBig+ peekWORD = liftStorable MedStore.peekBig+ peekUWORD = liftStorable MedStore.peekBig+ peekBYTE = liftStorable MedStore.peekOffset+ peekUBYTE = liftStorable MedStore.peekOffset+++newtype+ ByteStringReader a =+ ByteStringReader (MR.ReaderT ByteString (Either String) a)++instance Functor ByteStringReader where+ fmap f (ByteStringReader act) = ByteStringReader $ fmap f act++instance Applicative ByteStringReader where+ pure = ByteStringReader . pure+ ByteStringReader f <*> ByteStringReader m = ByteStringReader (f <*> m)++instance Monad ByteStringReader where+ return = pure+ ByteStringReader x >>= f =+ ByteStringReader $ x >>= \a -> case f a of ByteStringReader y -> y+ fail = ByteStringReader . MT.lift . Left++runByteString :: ByteStringReader a -> ByteString -> Either String a+runByteString (ByteStringReader rd) = MR.runReaderT rd++{-# INLINE liftByteString #-}+liftByteString :: MedBytes.Peek a -> PTR -> ByteStringReader a+liftByteString peek ptr =+ ByteStringReader (MR.ReaderT $ \mem -> Right $ peek mem ptr)++instance Reader ByteStringReader where+ peekLONG = liftByteString MedBytes.peekInt32+ peekULONG = liftByteString MedBytes.peekWord32+ peekWORD = liftByteString MedBytes.peekInt16+ peekUWORD = liftByteString MedBytes.peekWord16+ peekBYTE = liftByteString MedBytes.peekInt8+ peekUBYTE = liftByteString MedBytes.peekWord8
+ src-fail/from-4.13/Sound/MED/Basic/AmigaPrivate.hs view
@@ -0,0 +1,94 @@+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 = peekULONG+++newtype StorableReader a = StorableReader (MR.ReaderT MEM IO a)++instance Functor StorableReader where+ fmap f (StorableReader act) = StorableReader $ fmap f act++instance Applicative StorableReader where+ pure = StorableReader . pure+ StorableReader f <*> StorableReader m = StorableReader (f <*> m)++instance Monad StorableReader where+ return = pure+ StorableReader x >>= f =+ StorableReader $ x >>= \a -> case f a of StorableReader y -> y++instance MonadFail StorableReader where+ fail = StorableReader . MT.lift . fail++runStorable :: StorableReader a -> MEM -> IO a+runStorable (StorableReader rd) = MR.runReaderT rd++{-# INLINE liftStorable #-}+liftStorable :: MedStore.Peek a -> PTR -> StorableReader a+liftStorable peek ptr = StorableReader (MR.ReaderT $ \mem -> peek mem ptr)++instance Reader StorableReader where+ peekLONG = liftStorable MedStore.peekBig+ peekULONG = liftStorable MedStore.peekBig+ peekWORD = liftStorable MedStore.peekBig+ peekUWORD = liftStorable MedStore.peekBig+ peekBYTE = liftStorable MedStore.peekOffset+ peekUBYTE = liftStorable MedStore.peekOffset+++newtype+ ByteStringReader a =+ ByteStringReader (MR.ReaderT ByteString (Either String) a)++instance Functor ByteStringReader where+ fmap f (ByteStringReader act) = ByteStringReader $ fmap f act++instance Applicative ByteStringReader where+ pure = ByteStringReader . pure+ ByteStringReader f <*> ByteStringReader m = ByteStringReader (f <*> m)++instance Monad ByteStringReader where+ return = pure+ ByteStringReader x >>= f =+ ByteStringReader $ x >>= \a -> case f a of ByteStringReader y -> y++instance MonadFail ByteStringReader where+ fail = ByteStringReader . MT.lift . Left++runByteString :: ByteStringReader a -> ByteString -> Either String a+runByteString (ByteStringReader rd) = MR.runReaderT rd++{-# INLINE liftByteString #-}+liftByteString :: MedBytes.Peek a -> PTR -> ByteStringReader a+liftByteString peek ptr =+ ByteStringReader (MR.ReaderT $ \mem -> Right $ peek mem ptr)++instance Reader ByteStringReader where+ peekLONG = liftByteString MedBytes.peekInt32+ peekULONG = liftByteString MedBytes.peekWord32+ peekWORD = liftByteString MedBytes.peekInt16+ peekUWORD = liftByteString MedBytes.peekWord16+ peekBYTE = liftByteString MedBytes.peekInt8+ peekUBYTE = liftByteString MedBytes.peekWord8
src/Sound/MED/Basic/Amiga.hs view
@@ -6,99 +6,17 @@ loadMEM, freeMEM, ) where -import qualified Sound.MED.Basic.Storable as MedStore-import qualified Sound.MED.Basic.ByteString as MedBytes+import Sound.MED.Basic.AmigaPrivate+ import Sound.MED.Basic.Storable (MEM)-import Data.ByteString (ByteString) import Sound.MED.Basic.Utility (PTR, LONG, ULONG, WORD, UWORD, BYTE, UBYTE) import qualified System.IO as IO import qualified Foreign.Marshal.Alloc as Alloc -import qualified Control.Monad.Trans.Class as MT-import qualified Control.Monad.Trans.Reader as MR import Control.Monad (when)-import Control.Applicative (Applicative(pure, (<*>)), (<$>))--type Peek m a = PTR -> m a--class (Monad 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 = peekULONG---newtype StorableReader a = StorableReader (MR.ReaderT MEM IO a)--instance Functor StorableReader where- fmap f (StorableReader act) = StorableReader $ fmap f act--instance Applicative StorableReader where- pure = StorableReader . pure- StorableReader f <*> StorableReader m = StorableReader (f <*> m)--instance Monad StorableReader where- return = pure- StorableReader x >>= f =- StorableReader $ x >>= \a -> case f a of StorableReader y -> y- fail = StorableReader . MT.lift . fail--runStorable :: StorableReader a -> MEM -> IO a-runStorable (StorableReader rd) = MR.runReaderT rd--{-# INLINE liftStorable #-}-liftStorable :: MedStore.Peek a -> PTR -> StorableReader a-liftStorable peek ptr = StorableReader (MR.ReaderT $ \mem -> peek mem ptr)--instance Reader StorableReader where- peekLONG = liftStorable MedStore.peekBig- peekULONG = liftStorable MedStore.peekBig- peekWORD = liftStorable MedStore.peekBig- peekUWORD = liftStorable MedStore.peekBig- peekBYTE = liftStorable MedStore.peekOffset- peekUBYTE = liftStorable MedStore.peekOffset---newtype- ByteStringReader a =- ByteStringReader (MR.ReaderT ByteString (Either String) a)--instance Functor ByteStringReader where- fmap f (ByteStringReader act) = ByteStringReader $ fmap f act--instance Applicative ByteStringReader where- pure = ByteStringReader . pure- ByteStringReader f <*> ByteStringReader m = ByteStringReader (f <*> m)--instance Monad ByteStringReader where- return = pure- ByteStringReader x >>= f =- ByteStringReader $ x >>= \a -> case f a of ByteStringReader y -> y- fail = ByteStringReader . MT.lift . Left--runByteString :: ByteStringReader a -> ByteString -> Either String a-runByteString (ByteStringReader rd) = MR.runReaderT rd--{-# INLINE liftByteString #-}-liftByteString :: MedBytes.Peek a -> PTR -> ByteStringReader a-liftByteString peek ptr =- ByteStringReader (MR.ReaderT $ \mem -> Right $ peek mem ptr)--instance Reader ByteStringReader where- peekLONG = liftByteString MedBytes.peekInt32- peekULONG = liftByteString MedBytes.peekWord32- peekWORD = liftByteString MedBytes.peekInt16- peekUWORD = liftByteString MedBytes.peekWord16- peekBYTE = liftByteString MedBytes.peekInt8- peekUBYTE = liftByteString MedBytes.peekWord8+import Control.Applicative ((<$>)) loadMEM :: String -> IO MEM@@ -107,8 +25,7 @@ size <- fromInteger <$> IO.hFileSize h ptr <- Alloc.mallocBytes size readSize <- IO.hGetBuf h ptr size- when (readSize<size) $- ioError $ userError $ "loadMEM: incomplete load of " ++ s+ when (readSize<size) $ fail $ "loadMEM: incomplete load of " ++ s return ptr freeMEM :: MEM -> IO ()