{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      :  Codec.Audio.FLAC.Util
-- Copyright   :  © 2016–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Random non-public helpers.
module Codec.Audio.FLAC.Util
  ( maybePtr,
    toEnum',
    fromEnum',
    peekCStringText,
    withCStringText,
    withTempFile',
  )
where

import Control.Exception
import qualified Data.ByteString as B
import Data.Coerce
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Foreign
import Foreign.C.String
import System.Directory
import System.FilePath
import System.IO

-- | Coerce to 'Ptr' and check if it's a null pointer, return 'Nothing' if
-- it is, otherwise return the given pointer unchanged. Needless to say that
-- this thing is unsafe.
maybePtr :: Coercible a (Ptr p) => a -> Maybe a
maybePtr :: a -> Maybe a
maybePtr a :: a
a
  | a -> Ptr Any
forall a b. Coercible a b => a -> b
coerce a
a Ptr Any -> Ptr Any -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Any
forall a. Ptr a
nullPtr = Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just a
a

-- | A version of 'toEnum' that converts from any 'Integral' type.
toEnum' :: (Integral a, Enum b) => a -> b
toEnum' :: a -> b
toEnum' = Int -> b
forall a. Enum a => Int -> a
toEnum (Int -> b) -> (a -> Int) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | A version of 'fromEnum' that is polymorphic in return type.
fromEnum' :: (Integral a, Enum b) => b -> a
fromEnum' :: b -> a
fromEnum' = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> (b -> Int) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int
forall a. Enum a => a -> Int
fromEnum

-- | Peek 'CString' and decode it as UTF-8 encoded value.
peekCStringText :: CString -> IO Text
peekCStringText :: CString -> IO Text
peekCStringText = (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
T.decodeUtf8 (IO ByteString -> IO Text)
-> (CString -> IO ByteString) -> CString -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> IO ByteString
B.packCString

-- | Convert a 'Text' value to null-terminated C string that will be freed
-- automatically. Null bytes are removed from the 'Text' value first.
withCStringText :: Text -> (CString -> IO a) -> IO a
withCStringText :: Text -> (CString -> IO a) -> IO a
withCStringText text :: Text
text = ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
bytes
  where
    bytes :: ByteString
bytes = Text -> ByteString
T.encodeUtf8 ((Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\0') Text
text)

-- | A custom wrapper for creating temporary files in the same directory as
-- given file. 'Handle' is not opened, you only get 'FilePath' in the
-- callback.
withTempFile' :: FilePath -> (FilePath -> IO a) -> IO a
withTempFile' :: FilePath -> (FilePath -> IO a) -> IO a
withTempFile' path :: FilePath
path m :: FilePath -> IO a
m = IO (FilePath, Handle)
-> ((FilePath, Handle) -> IO ())
-> ((FilePath, Handle) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError IO (FilePath, Handle)
acquire (FilePath, Handle) -> IO ()
forall b. (FilePath, b) -> IO ()
cleanup (((FilePath, Handle) -> IO a) -> IO a)
-> ((FilePath, Handle) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
  \(path' :: FilePath
path', h :: Handle
h) -> Handle -> IO ()
hClose Handle
h IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO a
m FilePath
path'
  where
    acquire :: IO (FilePath, Handle)
acquire = FilePath -> FilePath -> IO (FilePath, Handle)
openBinaryTempFile FilePath
dir FilePath
file
    -- NOTE We need ignoringIOErrors in the case exception strikes before we
    -- create the actual file.
    cleanup :: (FilePath, b) -> IO ()
cleanup = IO () -> IO ()
ignoringIOErrors (IO () -> IO ())
-> ((FilePath, b) -> IO ()) -> (FilePath, b) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
removeFile (FilePath -> IO ())
-> ((FilePath, b) -> FilePath) -> (FilePath, b) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, b) -> FilePath
forall a b. (a, b) -> a
fst
    dir :: FilePath
dir = FilePath -> FilePath
takeDirectory FilePath
path
    file :: FilePath
file = FilePath -> FilePath
takeFileName FilePath
path

-- | Perform specified action ignoring IO exceptions it may throw.
ignoringIOErrors :: IO () -> IO ()
ignoringIOErrors :: IO () -> IO ()
ignoringIOErrors ioe :: IO ()
ioe = IO ()
ioe IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO ()
handler
  where
    handler :: IOError -> IO ()
    handler :: IOError -> IO ()
handler = IO () -> IOError -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())