module Sound.MIDI.File.Load (
fromFile, fromByteList, maybeFromByteList, maybeFromByteString,
showFile,
) where
import Sound.MIDI.File
import qualified Sound.MIDI.File as MIDIFile
import qualified Sound.MIDI.File.Event.Meta as MetaEvent
import qualified Sound.MIDI.File.Event as Event
import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Numeric.NonNegative.Wrapper as NonNeg
import Sound.MIDI.IO (ByteList, readBinaryFile, )
import Sound.MIDI.String (unlinesS)
import Sound.MIDI.Parser.Primitive
import qualified Sound.MIDI.Parser.Class as Parser
import qualified Sound.MIDI.Parser.Restricted as RestrictedParser
import qualified Sound.MIDI.Parser.ByteString as ByteStringParser
import qualified Sound.MIDI.Parser.Stream as StreamParser
import qualified Sound.MIDI.Parser.File as FileParser
import qualified Sound.MIDI.Parser.Status as StatusParser
import qualified Sound.MIDI.Parser.Report as Report
import Control.Monad.Trans.Class (lift, )
import Control.Monad (liftM, liftM2, )
import qualified Data.ByteString.Lazy as B
import qualified Control.Monad.Exception.Asynchronous as Async
import Data.List (genericReplicate, genericLength, )
import Data.Maybe (catMaybes, )
fromFile :: FilePath -> IO MIDIFile.T
fromFile :: FilePath -> IO T
fromFile =
Partial (Fragile T) T -> FilePath -> IO T
forall a. Partial (Fragile T) a -> FilePath -> IO a
FileParser.runIncompleteFile Partial (Fragile T) T
forall (parser :: * -> *). C parser => Partial (Fragile parser) T
parse
fromByteList :: ByteList -> MIDIFile.T
fromByteList :: ByteList -> T
fromByteList ByteList
contents =
(FilePath -> T) -> (T -> T) -> Either FilePath T -> T
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
FilePath -> T
forall a. HasCallStack => FilePath -> a
error T -> T
forall a. a -> a
id
(T T -> Either FilePath T
forall a. T a -> Either FilePath a
Report.result (ByteList -> T T
maybeFromByteList ByteList
contents))
maybeFromByteList ::
ByteList -> Report.T MIDIFile.T
maybeFromByteList :: ByteList -> T T
maybeFromByteList =
Partial (Fragile (T ByteList)) T -> ByteList -> T T
forall str a.
ByteStream str =>
Partial (Fragile (T str)) a -> str -> T a
StreamParser.runIncomplete Partial (Fragile (T ByteList)) T
forall (parser :: * -> *). C parser => Partial (Fragile parser) T
parse (ByteList -> T T) -> (ByteList -> ByteList) -> ByteList -> T T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteList -> ByteList
StreamParser.ByteList
maybeFromByteString ::
B.ByteString -> Report.T MIDIFile.T
maybeFromByteString :: ByteString -> T T
maybeFromByteString =
Partial (Fragile T) T -> ByteString -> T T
forall a. Partial (Fragile T) a -> ByteString -> T a
ByteStringParser.runIncomplete Partial (Fragile T) T
forall (parser :: * -> *). C parser => Partial (Fragile parser) T
parse
parse :: Parser.C parser => Parser.Partial (Parser.Fragile parser) MIDIFile.T
parse :: Partial (Fragile parser) T
parse =
Fragile parser (FilePath, Integer)
forall (parser :: * -> *).
C parser =>
Fragile parser (FilePath, Integer)
getChunk Fragile parser (FilePath, Integer)
-> ((FilePath, Integer) -> Partial (Fragile parser) T)
-> Partial (Fragile parser) T
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (FilePath
typ, Integer
hdLen) ->
case FilePath
typ of
FilePath
"MThd" ->
do (Type
format, Int
nTracks, Division
division) <-
Integer
-> Fragile (T parser) (Type, Int, Division)
-> Fragile parser (Type, Int, Division)
forall (parser :: * -> *) a.
C parser =>
Integer -> Fragile (T parser) a -> Fragile parser a
RestrictedParser.runFragile Integer
hdLen Fragile (T parser) (Type, Int, Division)
forall (parser :: * -> *).
C parser =>
Fragile parser (Type, Int, Division)
getHeader
PossiblyIncomplete [Maybe Track]
excTracks <-
parser (PossiblyIncomplete [Maybe Track])
-> ExceptionalT FilePath parser (PossiblyIncomplete [Maybe Track])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (parser (PossiblyIncomplete [Maybe Track])
-> ExceptionalT FilePath parser (PossiblyIncomplete [Maybe Track]))
-> parser (PossiblyIncomplete [Maybe Track])
-> ExceptionalT FilePath parser (PossiblyIncomplete [Maybe Track])
forall a b. (a -> b) -> a -> b
$ Partial (Fragile parser) (Maybe Track)
-> parser (PossiblyIncomplete [Maybe Track])
forall (parser :: * -> *) a.
EndCheck parser =>
Partial (Fragile parser) a -> Partial parser [a]
Parser.zeroOrMoreInc
(Partial (Fragile parser) (Maybe Track)
forall (parser :: * -> *).
C parser =>
Partial (Fragile parser) (Maybe Track)
getTrackChunk Partial (Fragile parser) (Maybe Track)
-> (PossiblyIncomplete (Maybe Track)
-> Partial (Fragile parser) (Maybe Track))
-> Partial (Fragile parser) (Maybe Track)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe Track -> ExceptionalT FilePath parser (Maybe Track))
-> PossiblyIncomplete (Maybe Track)
-> Partial (Fragile parser) (Maybe Track)
forall (m :: * -> *) a b e.
Monad m =>
(a -> m b) -> Exceptional e a -> m (Exceptional e b)
Async.mapM (parser (Maybe Track) -> ExceptionalT FilePath parser (Maybe Track)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (parser (Maybe Track)
-> ExceptionalT FilePath parser (Maybe Track))
-> (Maybe Track -> parser (Maybe Track))
-> Maybe Track
-> ExceptionalT FilePath parser (Maybe Track)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Track -> parser Track) -> Maybe Track -> parser (Maybe Track)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
liftMaybe Track -> parser Track
forall (parser :: * -> *). C parser => Track -> parser Track
removeEndOfTrack))
(([Maybe Track] -> ExceptionalT FilePath parser T)
-> PossiblyIncomplete [Maybe Track] -> Partial (Fragile parser) T)
-> PossiblyIncomplete [Maybe Track]
-> ([Maybe Track] -> ExceptionalT FilePath parser T)
-> Partial (Fragile parser) T
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Maybe Track] -> ExceptionalT FilePath parser T)
-> PossiblyIncomplete [Maybe Track] -> Partial (Fragile parser) T
forall (m :: * -> *) a b e.
Monad m =>
(a -> m b) -> Exceptional e a -> m (Exceptional e b)
Async.mapM PossiblyIncomplete [Maybe Track]
excTracks (([Maybe Track] -> ExceptionalT FilePath parser T)
-> Partial (Fragile parser) T)
-> ([Maybe Track] -> ExceptionalT FilePath parser T)
-> Partial (Fragile parser) T
forall a b. (a -> b) -> a -> b
$ \[Maybe Track]
tracks ->
do let n :: Int
n = [Maybe Track] -> Int
forall i a. Num i => [a] -> i
genericLength [Maybe Track]
tracks
parser () -> ExceptionalT FilePath parser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (parser () -> ExceptionalT FilePath parser ())
-> parser () -> ExceptionalT FilePath parser ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> parser ()
forall (parser :: * -> *).
C parser =>
Bool -> FilePath -> parser ()
Parser.warnIf (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nTracks)
(FilePath
"header says " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
nTracks FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" tracks, but " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" tracks were found")
T -> ExceptionalT FilePath parser T
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Division -> [Track] -> T
MIDIFile.Cons Type
format Division
division ([Track] -> T) -> [Track] -> T
forall a b. (a -> b) -> a -> b
$ [Maybe Track] -> [Track]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Track]
tracks)
FilePath
_ -> parser () -> ExceptionalT FilePath parser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FilePath -> parser ()
forall (parser :: * -> *). C parser => FilePath -> parser ()
Parser.warn (FilePath
"found Alien chunk <" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
typ FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
">")) ExceptionalT FilePath parser ()
-> ExceptionalT FilePath parser ()
-> ExceptionalT FilePath parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Integer -> ExceptionalT FilePath parser ()
forall (parser :: * -> *). C parser => Integer -> Fragile parser ()
Parser.skip Integer
hdLen ExceptionalT FilePath parser ()
-> Partial (Fragile parser) T -> Partial (Fragile parser) T
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Partial (Fragile parser) T
forall (parser :: * -> *). C parser => Partial (Fragile parser) T
parse
liftMaybe :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)
liftMaybe :: (a -> m b) -> Maybe a -> m (Maybe b)
liftMaybe a -> m b
f = m (Maybe b) -> (a -> m (Maybe b)) -> Maybe a -> m (Maybe b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe b -> m (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing) ((b -> Maybe b) -> m b -> m (Maybe b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> Maybe b
forall a. a -> Maybe a
Just (m b -> m (Maybe b)) -> (a -> m b) -> a -> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f)
removeEndOfTrack :: Parser.C parser => Track -> parser Track
removeEndOfTrack :: Track -> parser Track
removeEndOfTrack Track
xs =
parser Track
-> ((Track, (Integer, T)) -> parser Track)
-> Maybe (Track, (Integer, T))
-> parser Track
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(FilePath -> parser ()
forall (parser :: * -> *). C parser => FilePath -> parser ()
Parser.warn FilePath
"Empty track, missing EndOfTrack" parser () -> parser Track -> parser Track
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Track -> parser Track
forall (m :: * -> *) a. Monad m => a -> m a
return Track
xs)
(\(Track
initEvents, (Integer, T)
lastEvent) ->
let (Track
eots, Track
track) =
(T -> Bool) -> Track -> (Track, Track)
forall time body.
C time =>
(body -> Bool) -> T time body -> (T time body, T time body)
EventList.partition T -> Bool
isEndOfTrack Track
initEvents
in do Bool -> FilePath -> parser ()
forall (parser :: * -> *).
C parser =>
Bool -> FilePath -> parser ()
Parser.warnIf
(Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Track -> Bool
forall time body. T time body -> Bool
EventList.null Track
eots)
FilePath
"EndOfTrack inside a track"
Bool -> FilePath -> parser ()
forall (parser :: * -> *).
C parser =>
Bool -> FilePath -> parser ()
Parser.warnIf
(Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ T -> Bool
isEndOfTrack (T -> Bool) -> T -> Bool
forall a b. (a -> b) -> a -> b
$ (Integer, T) -> T
forall a b. (a, b) -> b
snd (Integer, T)
lastEvent)
FilePath
"Track does not end with EndOfTrack"
Track -> parser Track
forall (m :: * -> *) a. Monad m => a -> m a
return Track
track)
(Track -> Maybe (Track, (Integer, T))
forall time body. T time body -> Maybe (T time body, (time, body))
EventList.viewR Track
xs)
isEndOfTrack :: Event.T -> Bool
isEndOfTrack :: T -> Bool
isEndOfTrack T
ev =
case T
ev of
Event.MetaEvent T
MetaEvent.EndOfTrack -> Bool
True
T
_ -> Bool
False
getChunk :: Parser.C parser => Parser.Fragile parser (String, NonNeg.Integer)
getChunk :: Fragile parser (FilePath, Integer)
getChunk =
(FilePath -> Integer -> (FilePath, Integer))
-> ExceptionalT FilePath parser FilePath
-> ExceptionalT FilePath parser Integer
-> Fragile parser (FilePath, Integer)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,)
(Integer -> ExceptionalT FilePath parser FilePath
forall (parser :: * -> *).
C parser =>
Integer -> Fragile parser FilePath
getString Integer
4)
(Int -> ExceptionalT FilePath parser Integer
forall (parser :: * -> *).
C parser =>
Int -> Fragile parser Integer
getNByteCardinal Int
4)
getTrackChunk :: Parser.C parser => Parser.Partial (Parser.Fragile parser) (Maybe Track)
getTrackChunk :: Partial (Fragile parser) (Maybe Track)
getTrackChunk =
do (FilePath
typ, Integer
len) <- Fragile parser (FilePath, Integer)
forall (parser :: * -> *).
C parser =>
Fragile parser (FilePath, Integer)
getChunk
if FilePath
typFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==FilePath
"MTrk"
then (Exceptional FilePath Track -> PossiblyIncomplete (Maybe Track))
-> ExceptionalT FilePath parser (Exceptional FilePath Track)
-> Partial (Fragile parser) (Maybe Track)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Track -> Maybe Track)
-> Exceptional FilePath Track -> PossiblyIncomplete (Maybe Track)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Track -> Maybe Track
forall a. a -> Maybe a
Just) (ExceptionalT FilePath parser (Exceptional FilePath Track)
-> Partial (Fragile parser) (Maybe Track))
-> ExceptionalT FilePath parser (Exceptional FilePath Track)
-> Partial (Fragile parser) (Maybe Track)
forall a b. (a -> b) -> a -> b
$ parser (Exceptional FilePath Track)
-> ExceptionalT FilePath parser (Exceptional FilePath Track)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (parser (Exceptional FilePath Track)
-> ExceptionalT FilePath parser (Exceptional FilePath Track))
-> parser (Exceptional FilePath Track)
-> ExceptionalT FilePath parser (Exceptional FilePath Track)
forall a b. (a -> b) -> a -> b
$
Integer
-> T parser (Exceptional FilePath Track)
-> parser (Exceptional FilePath Track)
forall (parser :: * -> *) a.
C parser =>
Integer -> T parser a -> parser a
RestrictedParser.run Integer
len (T parser (Exceptional FilePath Track)
-> parser (Exceptional FilePath Track))
-> T parser (Exceptional FilePath Track)
-> parser (Exceptional FilePath Track)
forall a b. (a -> b) -> a -> b
$
T (T parser) (Exceptional FilePath Track)
-> T parser (Exceptional FilePath Track)
forall (parser :: * -> *) a. Monad parser => T parser a -> parser a
StatusParser.run T (T parser) (Exceptional FilePath Track)
forall (parser :: * -> *). C parser => Partial (T parser) Track
getTrack
else parser () -> ExceptionalT FilePath parser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FilePath -> parser ()
forall (parser :: * -> *). C parser => FilePath -> parser ()
Parser.warn (FilePath
"found Alien chunk <" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
typ FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"> in track section")) ExceptionalT FilePath parser ()
-> ExceptionalT FilePath parser ()
-> ExceptionalT FilePath parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Integer -> ExceptionalT FilePath parser ()
forall (parser :: * -> *). C parser => Integer -> Fragile parser ()
Parser.skip Integer
len ExceptionalT FilePath parser ()
-> Partial (Fragile parser) (Maybe Track)
-> Partial (Fragile parser) (Maybe Track)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
PossiblyIncomplete (Maybe Track)
-> Partial (Fragile parser) (Maybe Track)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Track -> PossiblyIncomplete (Maybe Track)
forall a e. a -> Exceptional e a
Async.pure Maybe Track
forall a. Maybe a
Nothing)
getHeader :: Parser.C parser => Parser.Fragile parser (MIDIFile.Type, NonNeg.Int, Division)
=
do
Type
format <- Int -> Fragile parser Type
forall (parser :: * -> *) enum.
(C parser, Enum enum, Bounded enum) =>
Int -> Fragile parser enum
makeEnum (Int -> Fragile parser Type)
-> ExceptionalT FilePath parser Int -> Fragile parser Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExceptionalT FilePath parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get2
Int
nTracks <- (Int -> Int)
-> ExceptionalT FilePath parser Int
-> ExceptionalT FilePath parser Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (FilePath -> Int -> Int
forall a. (Ord a, Num a) => FilePath -> a -> T a
NonNeg.fromNumberMsg FilePath
"MIDI.Load.getHeader") ExceptionalT FilePath parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get2
Division
division <- Fragile parser Division
forall (parser :: * -> *). C parser => Fragile parser Division
getDivision
(Type, Int, Division) -> Fragile parser (Type, Int, Division)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type
format, Int
nTracks, Division
division)
getDivision :: Parser.C parser => Parser.Fragile parser Division
getDivision :: Fragile parser Division
getDivision =
do
Int
x <- Fragile parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get1
Int
y <- Fragile parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get1
Division -> Fragile parser Division
forall (m :: * -> *) a. Monad m => a -> m a
return (Division -> Fragile parser Division)
-> Division -> Fragile parser Division
forall a b. (a -> b) -> a -> b
$
if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
128
then Int -> Division
Ticks (FilePath -> Int -> Int
forall a. (Ord a, Num a) => FilePath -> a -> T a
NonNeg.fromNumberMsg FilePath
"MIDI.Load.getDivision" (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
256Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y))
else Int -> Int -> Division
SMPTE (Int
256Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x) Int
y
getTrack :: Parser.C parser => Parser.Partial (StatusParser.T parser) MIDIFile.Track
getTrack :: Partial (T parser) Track
getTrack =
(Exceptional FilePath [(Integer, T)] -> Exceptional FilePath Track)
-> T parser (Exceptional FilePath [(Integer, T)])
-> Partial (T parser) Track
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
(([(Integer, T)] -> Track)
-> Exceptional FilePath [(Integer, T)]
-> Exceptional FilePath Track
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Integer, T)] -> Track
forall a b. [(a, b)] -> T a b
EventList.fromPairList)
(Fragile (T parser) (Integer, T)
-> T parser (Exceptional FilePath [(Integer, T)])
forall (parser :: * -> *) a.
EndCheck parser =>
Fragile parser a -> Partial parser [a]
Parser.zeroOrMore Fragile (T parser) (Integer, T)
forall (parser :: * -> *).
C parser =>
Fragile (T parser) (Integer, T)
Event.getTrackEvent)
{-# DEPRECATED showFile "only use this for debugging" #-}
showFile :: FilePath -> IO ()
showFile :: FilePath -> IO ()
showFile FilePath
fileName = FilePath -> IO ()
putStr (FilePath -> IO ()) -> (ByteList -> FilePath) -> ByteList -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteList -> FilePath
showChunks (ByteList -> IO ()) -> IO ByteList -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO ByteList
readBinaryFile FilePath
fileName
showChunks :: ByteList -> String
showChunks :: ByteList -> FilePath
showChunks ByteList
mf =
Fragile (T ByteList) (PossiblyIncomplete [(FilePath, ByteList)])
-> (PossiblyIncomplete [(FilePath, ByteList)]
-> FilePath -> FilePath)
-> ByteList
-> FilePath
-> FilePath
forall a.
Fragile (T ByteList) a
-> (a -> FilePath -> FilePath) -> ByteList -> FilePath -> FilePath
showMR (T ByteList (PossiblyIncomplete [(FilePath, ByteList)])
-> Fragile (T ByteList) (PossiblyIncomplete [(FilePath, ByteList)])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift T ByteList (PossiblyIncomplete [(FilePath, ByteList)])
forall (parser :: * -> *).
C parser =>
Partial parser [(FilePath, ByteList)]
getChunks) (\(Async.Exceptional Maybe FilePath
me [(FilePath, ByteList)]
cs) ->
[FilePath -> FilePath] -> FilePath -> FilePath
unlinesS (((FilePath, ByteList) -> FilePath -> FilePath)
-> [(FilePath, ByteList)] -> [FilePath -> FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, ByteList) -> FilePath -> FilePath
pp [(FilePath, ByteList)]
cs) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(FilePath -> FilePath)
-> (FilePath -> FilePath -> FilePath)
-> Maybe FilePath
-> FilePath
-> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath -> FilePath
forall a. a -> a
id (\FilePath
e -> FilePath -> FilePath -> FilePath
showString (FilePath
"incomplete chunk list: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
e FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n")) Maybe FilePath
me) ByteList
mf FilePath
""
where
pp :: (String, ByteList) -> ShowS
pp :: (FilePath, ByteList) -> FilePath -> FilePath
pp (FilePath
"MThd",ByteList
contents) =
FilePath -> FilePath -> FilePath
showString FilePath
"Header: " (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Fragile (T ByteList) (Type, Int, Division)
-> ((Type, Int, Division) -> FilePath -> FilePath)
-> ByteList
-> FilePath
-> FilePath
forall a.
Fragile (T ByteList) a
-> (a -> FilePath -> FilePath) -> ByteList -> FilePath -> FilePath
showMR Fragile (T ByteList) (Type, Int, Division)
forall (parser :: * -> *).
C parser =>
Fragile parser (Type, Int, Division)
getHeader (Type, Int, Division) -> FilePath -> FilePath
forall a. Show a => a -> FilePath -> FilePath
shows ByteList
contents
pp (FilePath
"MTrk",ByteList
contents) =
FilePath -> FilePath -> FilePath
showString FilePath
"Track:\n" (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Fragile (T ByteList) (Exceptional FilePath Track)
-> (Exceptional FilePath Track -> FilePath -> FilePath)
-> ByteList
-> FilePath
-> FilePath
forall a.
Fragile (T ByteList) a
-> (a -> FilePath -> FilePath) -> ByteList -> FilePath -> FilePath
showMR (T ByteList (Exceptional FilePath Track)
-> Fragile (T ByteList) (Exceptional FilePath Track)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (T ByteList (Exceptional FilePath Track)
-> Fragile (T ByteList) (Exceptional FilePath Track))
-> T ByteList (Exceptional FilePath Track)
-> Fragile (T ByteList) (Exceptional FilePath Track)
forall a b. (a -> b) -> a -> b
$ T (T ByteList) (Exceptional FilePath Track)
-> T ByteList (Exceptional FilePath Track)
forall (parser :: * -> *) a. Monad parser => T parser a -> parser a
StatusParser.run T (T ByteList) (Exceptional FilePath Track)
forall (parser :: * -> *). C parser => Partial (T parser) Track
getTrack)
(\(Async.Exceptional Maybe FilePath
me Track
track) FilePath
str ->
(Integer -> FilePath -> FilePath)
-> (T -> FilePath -> FilePath) -> FilePath -> Track -> FilePath
forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> b -> T time body -> b
EventList.foldr
Integer -> FilePath -> FilePath
MIDIFile.showTime
(\T
e -> T -> FilePath -> FilePath
MIDIFile.showEvent T
e (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
showString FilePath
"\n")
(FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" (\FilePath
e -> FilePath
"incomplete track: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
e FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n") Maybe FilePath
me FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
str) Track
track)
ByteList
contents
pp (FilePath
ty,ByteList
contents) =
FilePath -> FilePath -> FilePath
showString FilePath
"Alien Chunk: " (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
FilePath -> FilePath -> FilePath
showString FilePath
ty (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
FilePath -> FilePath -> FilePath
showString FilePath
" " (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ByteList -> FilePath -> FilePath
forall a. Show a => a -> FilePath -> FilePath
shows ByteList
contents (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
FilePath -> FilePath -> FilePath
showString FilePath
"\n"
showMR :: Parser.Fragile (StreamParser.T StreamParser.ByteList) a -> (a->ShowS) -> ByteList -> ShowS
showMR :: Fragile (T ByteList) a
-> (a -> FilePath -> FilePath) -> ByteList -> FilePath -> FilePath
showMR Fragile (T ByteList) a
m a -> FilePath -> FilePath
pp ByteList
contents =
let report :: T a
report = Fragile (T ByteList) a -> ByteList -> T a
forall str a. ByteStream str => Fragile (T str) a -> str -> T a
StreamParser.run Fragile (T ByteList) a
m (ByteList -> ByteList
StreamParser.ByteList ByteList
contents)
in [FilePath -> FilePath] -> FilePath -> FilePath
unlinesS ((FilePath -> FilePath -> FilePath)
-> [FilePath] -> [FilePath -> FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath -> FilePath
showString ([FilePath] -> [FilePath -> FilePath])
-> [FilePath] -> [FilePath -> FilePath]
forall a b. (a -> b) -> a -> b
$ T a -> [FilePath]
forall a. T a -> [FilePath]
Report.warnings T a
report) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(FilePath -> FilePath -> FilePath)
-> (a -> FilePath -> FilePath)
-> Either FilePath a
-> FilePath
-> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> FilePath -> FilePath
showString a -> FilePath -> FilePath
pp (T a -> Either FilePath a
forall a. T a -> Either FilePath a
Report.result T a
report)
getChunks ::
Parser.C parser => Parser.Partial parser [(String, ByteList)]
getChunks :: Partial parser [(FilePath, ByteList)]
getChunks =
Fragile parser (FilePath, ByteList)
-> Partial parser [(FilePath, ByteList)]
forall (parser :: * -> *) a.
EndCheck parser =>
Fragile parser a -> Partial parser [a]
Parser.zeroOrMore (Fragile parser (FilePath, ByteList)
-> Partial parser [(FilePath, ByteList)])
-> Fragile parser (FilePath, ByteList)
-> Partial parser [(FilePath, ByteList)]
forall a b. (a -> b) -> a -> b
$
do (FilePath
typ, Integer
len) <- Fragile parser (FilePath, Integer)
forall (parser :: * -> *).
C parser =>
Fragile parser (FilePath, Integer)
getChunk
ByteList
body <- [ExceptionalT FilePath parser Word8]
-> ExceptionalT FilePath parser ByteList
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Integer
-> ExceptionalT FilePath parser Word8
-> [ExceptionalT FilePath parser Word8]
forall i a. Integral i => i -> a -> [a]
genericReplicate Integer
len ExceptionalT FilePath parser Word8
forall (parser :: * -> *). C parser => Fragile parser Word8
getByte)
(FilePath, ByteList) -> Fragile parser (FilePath, ByteList)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
typ, ByteList
body)