-- | Sound file functions.
module Sound.Sc3.Common.SoundFile where

import System.Environment {- base -}
import System.IO.Unsafe {- base -}
import System.Process {- process -}

import System.Directory {- directory -}
import System.FilePath {- filepath -}

import qualified Sound.Sc3.Common.Base {- hsc3 -}

{- | Find the file fn (case-sensitively) starting from dir.
Runs the system command "find" (so UNIX only).
Note that fn must be a file name not a relative path name.

> findFileFromDirectory "/home/rohan/data/audio" "metal.wav"
-}
findFileFromDirectory :: String -> String -> IO (Maybe String)
findFileFromDirectory :: String -> String -> IO (Maybe String)
findFileFromDirectory String
dir String
fn = do
  String
r <- String -> [String] -> String -> IO String
System.Process.readProcess String
"find" [String
dir, String
"-name", String
fn] String
""
  case String -> [String]
lines String
r of
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    [String
r0] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just String
r0)
    [String]
_ -> forall a. HasCallStack => String -> a
error String
"findFileFromDirectory: multiple files?"


{- | Find the file fn starting from dir.
If dir/fn names a file return that file, else call findFileFromDirectory.
Note this will not find dir/p/q/r given q/r, the query must be either p/q/r or r.

> findFileAtOrFromDirectory "/home/rohan/data/audio" "instr/bosendorfer/072/C5.aif"
-}
findFileAtOrFromDirectory :: String -> String -> IO (Maybe String)
findFileAtOrFromDirectory :: String -> String -> IO (Maybe String)
findFileAtOrFromDirectory String
dir String
fn = do
  Bool
isAtDir <- String -> IO Bool
doesFileExist (String
dir String -> String -> String
</> String
fn)
  if Bool
isAtDir then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (String
dir String -> String -> String
</> String
fn)) else String -> String -> IO (Maybe String)
findFileFromDirectory String
dir String
fn

{- | Run findFileAtOrFromDirectory for each entry in path until the file is found, or not.

> findFileAtOrFromPath ["/home/rohan/rd/data/"] "20.2-LW+RD.flac"
-}
findFileAtOrFromPath :: [FilePath] -> FilePath -> IO (Maybe FilePath)
findFileAtOrFromPath :: [String] -> String -> IO (Maybe String)
findFileAtOrFromPath [String]
path String
fn =
  case [String]
path of
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    String
dir:[String]
path' -> do
      Maybe String
m <- String -> String -> IO (Maybe String)
findFileAtOrFromDirectory String
dir String
fn
      case Maybe String
m of
        Just String
r -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just String
r)
        Maybe String
Nothing -> [String] -> String -> IO (Maybe String)
findFileAtOrFromPath [String]
path' String
fn

-- | SFDIR environment variable.
sfDir :: IO FilePath
sfDir :: IO String
sfDir = String -> IO String
getEnv String
"SFDIR"

-- | SFPATH environment variable.
sfPath :: IO FilePath
sfPath :: IO String
sfPath = String -> IO String
getEnv String
"SFPATH"

{- | Find file fn at 'sfDir' directly or along 'sfPath'.
If fn is either absolute or names a relative file and if that file exists it is returned.
If sdDir/fn exists it is returned.
Else each directory at sfPath is searched (recursively) in turn.
Despite the name this will find any file type along the SFDIR and SFPATH, i.e. .sfz files &etc.

> mapM sfFindFile ["/home/rohan/data/audio/metal.wav", "pf-c5.aif", "20.2-LW+RD.flac"]
-}
sfFindFile :: FilePath -> IO (Maybe FilePath)
sfFindFile :: String -> IO (Maybe String)
sfFindFile String
fn = do
  String
dir <- IO String
sfDir
  [String]
path <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> String -> [String]
Sound.Sc3.Common.Base.string_split_at_char Char
':') IO String
sfPath
  Bool
isFn <- String -> IO Bool
doesFileExist String
fn
  Bool
isDir <- String -> IO Bool
doesFileExist (String
dir String -> String -> String
</> String
fn)
  if Bool
isFn then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just String
fn) else if Bool
isDir then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (String
dir String -> String -> String
</> String
fn)) else [String] -> String -> IO (Maybe String)
findFileAtOrFromPath [String]
path String
fn

-- | sfFindFile or error.
sfResolveFile :: FilePath -> IO FilePath
sfResolveFile :: String -> IO String
sfResolveFile String
fn = do
  Maybe String
m <- String -> IO (Maybe String)
sfFindFile String
fn
  case Maybe String
m of
    Maybe String
Nothing  -> forall a. HasCallStack => String -> a
error (String
"sfResolveFile: " forall a. [a] -> [a] -> [a]
++ String
fn)
    Just String
r -> forall (m :: * -> *) a. Monad m => a -> m a
return String
r

{- | Unsafe sfResolveFile.
For resolving sound file names at read only sound file archives this is quite safe.
-}
sfResolve :: FilePath -> FilePath
sfResolve :: String -> String
sfResolve = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
sfResolveFile

{- | Return the number of channels at fn.
Runs the system command "soxi" (so UNIX only).

> sfResolveFile "metal.wav" >>= sfNumChannels >>= print
-}
sfNumChannels :: FilePath -> IO Int
sfNumChannels :: String -> IO Int
sfNumChannels String
fn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Read a => String -> a
read (String -> [String] -> String -> IO String
System.Process.readProcess String
"soxi" [String
"-c", String
fn] String
"")

{- | Return the sample rate of fn.
Runs the system command "soxi" (so UNIX only).

> sfResolveFile "metal.wav" >>= sfSampleRate >>= print
-}
sfSampleRate :: FilePath -> IO Int
sfSampleRate :: String -> IO Int
sfSampleRate String
fn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Read a => String -> a
read (String -> [String] -> String -> IO String
System.Process.readProcess String
"soxi" [String
"-r", String
fn] String
"")

{- | Return the number of frames at fn.
Runs the system command "soxi" (so UNIX only).

> sfResolveFile "metal.wav" >>= sfFrameCount >>= print
-}
sfFrameCount :: FilePath -> IO Int
sfFrameCount :: String -> IO Int
sfFrameCount String
fn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Read a => String -> a
read (String -> [String] -> String -> IO String
System.Process.readProcess String
"soxi" [String
"-s", String
fn] String
"")

{- | Return the number of channels, sample-rate and number of frames at fn.
Runs the system command "soxi" (so UNIX only).

> sfResolveFile "metal.wav" >>= sfMetadata >>= print
-}
sfMetadata :: FilePath -> IO (Int, Int, Int)
sfMetadata :: String -> IO (Int, Int, Int)
sfMetadata String
fn = do
  Int
nc <- String -> IO Int
sfNumChannels String
fn
  Int
sr <- String -> IO Int
sfSampleRate String
fn
  Int
nf <- String -> IO Int
sfFrameCount String
fn
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
nc, Int
sr, Int
nf)

{- | Unsafe sfMetadata.
For fetching sound file information from read only sound file archives this is quite safe.

> sfInfo (sfResolve "metal.wav") == (1,44100,1029664)
> sfInfo (sfResolve "pf-c5.aif") == (2,44100,576377)
-}
sfInfo :: FilePath -> (Int, Int, Int)
sfInfo :: String -> (Int, Int, Int)
sfInfo = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Int, Int, Int)
sfMetadata