module Sound.MIDI.Parser.File
   (T(..), runFile, runHandle, runIncompleteFile,
    PossiblyIncomplete, UserMessage, ) where

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

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

import qualified System.IO.Error as IOE
import qualified Control.Exception as Exc
import qualified Control.Monad.Exception.Asynchronous as Async
import qualified Control.Monad.Exception.Synchronous  as Sync

import qualified System.IO as IO
import Data.Char (ord)

import qualified Numeric.NonNegative.Wrapper as NonNeg



newtype T a = Cons {forall a. T a -> ReaderT Handle IO a
decons :: ReaderT IO.Handle IO a}


runFile :: Parser.Fragile T a -> FilePath -> IO a
runFile :: forall a. Fragile T a -> FilePath -> IO a
runFile Fragile T a
p FilePath
name =
   forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exc.bracket
      (FilePath -> IOMode -> IO Handle
IO.openBinaryFile FilePath
name IOMode
IO.ReadMode)
      Handle -> IO ()
IO.hClose
      (forall a. Fragile T a -> Handle -> IO a
runHandle Fragile T a
p)

runHandle :: Parser.Fragile T a -> IO.Handle -> IO a
runHandle :: forall a. Fragile T a -> Handle -> IO a
runHandle Fragile T a
p Handle
h =
   do Exceptional FilePath a
exc <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall a. T a -> ReaderT Handle IO a
decons (forall (m :: * -> *) e a.
Monad m =>
ExceptionalT e m a -> m (Exceptional e a)
Sync.tryT Fragile T a
p)) Handle
h
      forall e a. (e -> a) -> Exceptional e a -> a
Sync.resolve (forall a. IOError -> IO a
IOE.ioError forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IOError
IOE.userError) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => a -> m a
return Exceptional FilePath a
exc)



{- |
Since in case of an incomplete file read,
we cannot know where the current file position is,
we omit the @runIncompleteHandle@ variant.
-}
runIncompleteFile :: Parser.Partial (Parser.Fragile T) a -> FilePath -> IO a
runIncompleteFile :: forall a. Partial (Fragile T) a -> FilePath -> IO a
runIncompleteFile Partial (Fragile T) a
p FilePath
name =
   forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exc.bracket
      (FilePath -> IOMode -> IO Handle
IO.openBinaryFile FilePath
name IOMode
IO.ReadMode)
      Handle -> IO ()
IO.hClose
      (\Handle
h ->
          do (Async.Exceptional Maybe FilePath
me a
a) <- forall a. Fragile T a -> Handle -> IO a
runHandle Partial (Fragile T) a
p Handle
h
             forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ())
                 (\FilePath
msg -> FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"could not parse MIDI file completely: " forall a. [a] -> [a] -> [a]
++ FilePath
msg) Maybe FilePath
me
             forall (m :: * -> *) a. Monad m => a -> m a
return a
a)



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 (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 a. ReaderT Handle IO a -> T a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
   T a
x >>= :: forall a b. T a -> (a -> T b) -> T b
>>= a -> T b
y = forall a. ReaderT Handle IO a -> T a
Cons forall a b. (a -> b) -> a -> b
$ forall a. T a -> ReaderT Handle IO 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 -> ReaderT Handle IO a
decons T a
x

fromIO :: (IO.Handle -> IO a) -> T a
fromIO :: forall a. (Handle -> IO a) -> T a
fromIO Handle -> IO a
act = forall a. ReaderT Handle IO 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO a
act forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) r. Monad m => ReaderT r m r
ask

ioeTry :: IO a -> IO (Either IOError a)
ioeTry :: forall a. IO a -> IO (Either IOError a)
ioeTry = forall e a. Exception e => IO a -> IO (Either e a)
Exc.try

fragileFromIO :: (IO.Handle -> IO a) -> Parser.Fragile T a
fragileFromIO :: forall a. (Handle -> IO a) -> Fragile T a
fragileFromIO Handle -> IO a
act =
   forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
Sync.ExceptionalT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ReaderT Handle IO a -> T a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall e0 e1 a. (e0 -> e1) -> Exceptional e0 a -> Exceptional e1 a
Sync.mapException forall a. Show a => a -> FilePath
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Either e a -> Exceptional e a
Sync.fromEither) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO (Either IOError a)
ioeTry forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO a
act
          forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall a. ReaderT Handle IO a -> T a
Cons forall (m :: * -> *) r. Monad m => ReaderT r m r
ask)

instance Parser.EndCheck T where
   isEnd :: T Bool
isEnd   = forall a. (Handle -> IO a) -> T a
fromIO Handle -> IO Bool
IO.hIsEOF

instance Parser.C T where
   getByte :: Fragile T Word8
getByte = forall a. (Handle -> IO a) -> Fragile T a
fragileFromIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO Char
IO.hGetChar
   skip :: Integer -> Fragile T ()
skip Integer
n  = forall a. (Handle -> IO a) -> Fragile T a
fragileFromIO forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> SeekMode -> Integer -> IO ()
IO.hSeek Handle
h SeekMode
IO.RelativeSeek (forall a. T a -> a
NonNeg.toNumber Integer
n)
   warn :: FilePath -> T ()
warn    = forall a. ReaderT Handle IO a -> T a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\FilePath
msg -> FilePath -> IO ()
putStrLn (FilePath
"warning: " forall a. [a] -> [a] -> [a]
++ FilePath
msg))