-- Copyright 2019 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Wrap "Sound.File.Sndfile" for better errors and to work around bugs.
module Util.Audio.Sndfile (
    Handle
    , openFile, hInfo, hClose, hSeek, hGetBuffer, hPutBuffer
    , hFrames
    , ignoreEnoent
    , module Sndfile
) where
import qualified Control.Exception as Exception
import qualified Data.IORef as IORef
import qualified Data.List as List
import qualified Sound.File.Sndfile as Sndfile
import           Sound.File.Sndfile
       hiding (Handle, openFile, hInfo, hClose, hSeek, hGetBuffer, hPutBuffer)

import           Global


data Handle = Handle {
    Handle -> String
_filename :: !FilePath
    -- | libsndfile has no protection against multiple closes on the same
    -- handle and happily double frees memory, and hsndfile provides no
    -- protection either.
    , Handle -> IORef Bool
_isOpen :: !(IORef.IORef Bool)
    , Handle -> Handle
_handle :: !Sndfile.Handle
    }

instance Show Handle where
    show :: Handle -> String
show Handle
hdl = String
"(Handle " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Handle -> String
_filename Handle
hdl) forall a. Semigroup a => a -> a -> a
<> String
")"

openFile :: FilePath -> IOMode -> Info -> IO Handle
openFile :: String -> IOMode -> Info -> IO Handle
openFile String
fname IOMode
mode Info
info = forall a. String -> String -> IO a -> IO a
withFilename String
"openFile" String
fname forall a b. (a -> b) -> a -> b
$ do
    Handle
hdl <- String -> IOMode -> Info -> IO Handle
Sndfile.openFile String
fname IOMode
mode Info
info
    IORef Bool
open <- forall a. a -> IO (IORef a)
IORef.newIORef Bool
True
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> IORef Bool -> Handle -> Handle
Handle String
fname IORef Bool
open Handle
hdl

hInfo :: Handle -> Info
hInfo :: Handle -> Info
hInfo = Handle -> Info
Sndfile.hInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Handle
_handle

hClose :: Handle -> IO ()
hClose :: Handle -> IO ()
hClose Handle
hdl = forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall a. IORef a -> IO a
IORef.readIORef (Handle -> IORef Bool
_isOpen Handle
hdl)) forall a b. (a -> b) -> a -> b
$ do
    forall a. IORef a -> a -> IO ()
IORef.atomicWriteIORef (Handle -> IORef Bool
_isOpen Handle
hdl) Bool
False
    -- hsndfile is buggy and calls sf_error(nullptr) after closing the handle,
    -- which gets any previous error that might still be in a static variable.
    Handle -> IO ()
Sndfile.hClose (Handle -> Handle
_handle Handle
hdl)
        forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Exception.catch` \(Exception
_exc :: Sndfile.Exception) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

hSeek :: Handle -> Count -> IO Count
hSeek :: Handle -> Count -> IO Count
hSeek Handle
hdl Count
count
    | Count
0 forall a. Ord a => a -> a -> Bool
<= Count
count Bool -> Bool -> Bool
&& Count
count forall a. Ord a => a -> a -> Bool
<= Handle -> Count
hFrames Handle
hdl =
        Handle -> SeekMode -> Count -> IO Count
Sndfile.hSeek (Handle -> Handle
_handle Handle
hdl) SeekMode
AbsoluteSeek Count
count
    -- Otherwise libsndfile will throw a much more confusing error:
    -- "Internal psf_fseek() failed."
    -- It's ok to seek to the end of the file though, and that happens when the
    -- resample consumed all samples, but they're in its internal buffer.
    | Bool
otherwise = forall a e. Exception e => e -> a
Exception.throw forall a b. (a -> b) -> a -> b
$ String -> Exception
Sndfile.Exception forall a b. (a -> b) -> a -> b
$
        String
"tried to seek to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Count
count forall a. Semigroup a => a -> a -> a
<> String
" in " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Handle -> String
_filename Handle
hdl)
        forall a. Semigroup a => a -> a -> a
<> String
", but it only has " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Handle -> Count
hFrames Handle
hdl)

hFrames :: Handle -> Count
hFrames :: Handle -> Count
hFrames = Info -> Count
Sndfile.frames forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Info
Sndfile.hInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Handle
_handle

hGetBuffer :: (Sample e, Buffer a e) => Handle -> Count -> IO (Maybe (a e))
hGetBuffer :: forall e (a :: * -> *).
(Sample e, Buffer a e) =>
Handle -> Count -> IO (Maybe (a e))
hGetBuffer Handle
hdl Count
count = forall a. String -> String -> IO a -> IO a
withFilename String
"hGetBuffer" (Handle -> String
_filename Handle
hdl) forall a b. (a -> b) -> a -> b
$
    forall (a :: * -> *) e.
(Sample e, Storable e, Buffer a e) =>
Handle -> Count -> IO (Maybe (a e))
Sndfile.hGetBuffer (Handle -> Handle
_handle Handle
hdl) Count
count

hPutBuffer :: (Sample e, Buffer a e) => Handle -> a e -> IO Count
hPutBuffer :: forall e (a :: * -> *).
(Sample e, Buffer a e) =>
Handle -> a e -> IO Count
hPutBuffer Handle
hdl a e
buf = forall (a :: * -> *) e.
(Sample e, Storable e, Buffer a e) =>
Handle -> a e -> IO Count
Sndfile.hPutBuffer (Handle -> Handle
_handle Handle
hdl) a e
buf

-- | Sndfile's errors don't include the filename.
withFilename :: String -> FilePath -> IO a -> IO a
withFilename :: forall a. String -> String -> IO a -> IO a
withFilename String
operation String
fname = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Exception.handle forall a b. (a -> b) -> a -> b
$
    forall a e. Exception e => e -> a
Exception.throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception -> Exception
annotate (String
operation forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
fname forall a. Semigroup a => a -> a -> a
<> String
": ")

annotate :: String -> Exception -> Exception
annotate :: String -> Exception -> Exception
annotate String
prefix = \case
    Sndfile.Exception String
err -> String -> Exception
Sndfile.Exception forall a b. (a -> b) -> a -> b
$ String
prefix forall a. Semigroup a => a -> a -> a
<> String
err
    Sndfile.UnrecognisedFormat String
err -> String -> Exception
Sndfile.UnrecognisedFormat forall a b. (a -> b) -> a -> b
$ String
prefix forall a. Semigroup a => a -> a -> a
<> String
err
    Sndfile.SystemError String
err -> String -> Exception
Sndfile.SystemError forall a b. (a -> b) -> a -> b
$ String
prefix forall a. Semigroup a => a -> a -> a
<> String
err
    Sndfile.MalformedFile String
err -> String -> Exception
Sndfile.MalformedFile forall a b. (a -> b) -> a -> b
$ String
prefix forall a. Semigroup a => a -> a -> a
<> String
err
    Sndfile.UnsupportedEncoding String
err ->
        String -> Exception
Sndfile.UnsupportedEncoding forall a b. (a -> b) -> a -> b
$ String
prefix forall a. Semigroup a => a -> a -> a
<> String
err

ignoreEnoent :: IO a -> IO (Maybe a)
ignoreEnoent :: forall a. IO a -> IO (Maybe a)
ignoreEnoent = forall e a. Exception e => (e -> Bool) -> IO a -> IO (Maybe a)
ignoreError forall a b. (a -> b) -> a -> b
$ \case
    -- hsndfile doesn't preserve the underlying error code
    Sndfile.SystemError String
msg -> String
"No such file or directory" forall a. Eq a => [a] -> [a] -> Bool
`List.isInfixOf` String
msg
    Exception
_ -> Bool
False

ignoreError :: Exception.Exception e => (e -> Bool) -> IO a -> IO (Maybe a)
ignoreError :: forall e a. Exception e => (e -> Bool) -> IO a -> IO (Maybe a)
ignoreError e -> Bool
ignore IO a
action = forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
Exception.handleJust (forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Bool
ignore)
    (forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just IO a
action)