{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}

{-|
Description:    Internal module to allow constructor access without pollution.

Copyright:      (c) 2019-2021 Sam May
License:        GPL-3.0-or-later
Maintainer:     ag@eitilt.life

Stability:      stable
Portability:    non-portable (requires libcdio)
-}
module Sound.Libcdio.Types.Cdio
    ( Cdio
    , CdioError ( .. )
    , CdioErrorType ( .. )
    , Foreign.SessionArg ( .. )
    , Foreign.AccessMode ( .. )
    , liftCdio
    , liftCdio'
    , liftCdioError
    , liftCdioError'
    , packCdioError
    , packCdioError'
    , open
    , openMode
    , getArg
    , getAccessMode
    , runCdio
    ) where


import qualified Control.Applicative as A
#if MIN_VERSION_mtl(2,2,1)
import qualified Control.Monad.Except as N.E
#else
import qualified Control.Monad.Error as N.E
#endif
import qualified Control.Monad.Fail as N.F

import qualified Data.Text as T

import qualified Foreign.Libcdio.Device as Foreign
import qualified Foreign.Libcdio.Logging as Foreign

import Sound.Libcdio.Logging

import Control.Applicative ( (<|>) )
import Data.Array.BitArray ( (!) )


-- | A computation within the environment of the data (music or file) stored on
-- a CD.  The options for affecting that environment from within are limited by
-- design, as this library is intended for /reading/ discs rather than
-- /authoring/ them.
newtype Cdio a = Cdio (Foreign.Cdio -> IO (Either CdioError a))
instance Functor Cdio where
    fmap :: (a -> b) -> Cdio a -> Cdio b
fmap a -> b
f (Cdio Cdio -> IO (Either CdioError a)
a) = (Cdio -> IO (Either CdioError b)) -> Cdio b
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError b)) -> Cdio b)
-> (Cdio -> IO (Either CdioError b)) -> Cdio b
forall a b. (a -> b) -> a -> b
$ \Cdio
c -> (a -> b) -> Either CdioError a -> Either CdioError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Either CdioError a -> Either CdioError b)
-> IO (Either CdioError a) -> IO (Either CdioError b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cdio -> IO (Either CdioError a)
a Cdio
c
instance Applicative Cdio where
    pure :: a -> Cdio a
pure a
a = (Cdio -> IO (Either CdioError a)) -> Cdio a
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError a)) -> Cdio a)
-> (Either CdioError a -> Cdio -> IO (Either CdioError a))
-> Either CdioError a
-> Cdio a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either CdioError a) -> Cdio -> IO (Either CdioError a)
forall a b. a -> b -> a
const (IO (Either CdioError a) -> Cdio -> IO (Either CdioError a))
-> (Either CdioError a -> IO (Either CdioError a))
-> Either CdioError a
-> Cdio
-> IO (Either CdioError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either CdioError a -> IO (Either CdioError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CdioError a -> Cdio a) -> Either CdioError a -> Cdio a
forall a b. (a -> b) -> a -> b
$ a -> Either CdioError a
forall a b. b -> Either a b
Right a
a
    Cdio Cdio -> IO (Either CdioError (a -> b))
f <*> :: Cdio (a -> b) -> Cdio a -> Cdio b
<*> Cdio Cdio -> IO (Either CdioError a)
a = (Cdio -> IO (Either CdioError b)) -> Cdio b
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError b)) -> Cdio b)
-> (Cdio -> IO (Either CdioError b)) -> Cdio b
forall a b. (a -> b) -> a -> b
$ \Cdio
c -> do
        Either CdioError (a -> b)
f' <- Cdio -> IO (Either CdioError (a -> b))
f Cdio
c
        Either CdioError a
a' <- Cdio -> IO (Either CdioError a)
a Cdio
c
        Either CdioError b -> IO (Either CdioError b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CdioError b -> IO (Either CdioError b))
-> Either CdioError b -> IO (Either CdioError b)
forall a b. (a -> b) -> a -> b
$ Either CdioError (a -> b)
f' Either CdioError (a -> b)
-> Either CdioError a -> Either CdioError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either CdioError a
a'
-- | 'A.empty' fails with 'CdioEmpty'.
instance A.Alternative Cdio where
    empty :: Cdio a
empty = (Cdio -> IO (Either CdioError a)) -> Cdio a
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError a)) -> Cdio a)
-> (Cdio -> IO (Either CdioError a)) -> Cdio a
forall a b. (a -> b) -> a -> b
$ \Cdio
_ -> Either CdioError a -> IO (Either CdioError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CdioError a -> IO (Either CdioError a))
-> (Text -> Either CdioError a) -> Text -> IO (Either CdioError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CdioError -> Either CdioError a
forall a b. a -> Either a b
Left (CdioError -> Either CdioError a)
-> (Text -> CdioError) -> Text -> Either CdioError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CdioErrorType -> Text -> CdioError
CdioError CdioErrorType
CdioEmpty (Text -> IO (Either CdioError a))
-> Text -> IO (Either CdioError a)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"empty"
    Cdio Cdio -> IO (Either CdioError a)
f <|> :: Cdio a -> Cdio a -> Cdio a
<|> Cdio Cdio -> IO (Either CdioError a)
g = (Cdio -> IO (Either CdioError a)) -> Cdio a
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError a)) -> Cdio a)
-> (Cdio -> IO (Either CdioError a)) -> Cdio a
forall a b. (a -> b) -> a -> b
$ \Cdio
c -> Cdio -> IO (Either CdioError a)
f Cdio
c IO (Either CdioError a)
-> IO (Either CdioError a) -> IO (Either CdioError a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Cdio -> IO (Either CdioError a)
g Cdio
c
instance Monad Cdio where
    Cdio Cdio -> IO (Either CdioError a)
a >>= :: Cdio a -> (a -> Cdio b) -> Cdio b
>>= a -> Cdio b
f = (Cdio -> IO (Either CdioError b)) -> Cdio b
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError b)) -> Cdio b)
-> (Cdio -> IO (Either CdioError b)) -> Cdio b
forall a b. (a -> b) -> a -> b
$ \Cdio
c -> do
        Either CdioError a
a' <- Cdio -> IO (Either CdioError a)
a Cdio
c
        case Either CdioError a
a' of
            Left CdioError
e -> Either CdioError b -> IO (Either CdioError b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CdioError b -> IO (Either CdioError b))
-> Either CdioError b -> IO (Either CdioError b)
forall a b. (a -> b) -> a -> b
$ CdioError -> Either CdioError b
forall a b. a -> Either a b
Left CdioError
e
            Right a
x -> let Cdio Cdio -> IO (Either CdioError b)
b = a -> Cdio b
f a
x in Cdio -> IO (Either CdioError b)
b Cdio
c
-- | Wraps the text in a 'FreeformCdioError', for recovery with 'N.E.catchError'.
instance N.F.MonadFail Cdio where
    fail :: String -> Cdio a
fail String
e = (Cdio -> IO (Either CdioError a)) -> Cdio a
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError a)) -> Cdio a)
-> (Text -> Cdio -> IO (Either CdioError a)) -> Text -> Cdio a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either CdioError a) -> Cdio -> IO (Either CdioError a)
forall a b. a -> b -> a
const (IO (Either CdioError a) -> Cdio -> IO (Either CdioError a))
-> (Text -> IO (Either CdioError a))
-> Text
-> Cdio
-> IO (Either CdioError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either CdioError a -> IO (Either CdioError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CdioError a -> IO (Either CdioError a))
-> (Text -> Either CdioError a) -> Text -> IO (Either CdioError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CdioErrorType -> String -> Either CdioError a)
-> String -> CdioErrorType -> Either CdioError a
forall a b c. (a -> b -> c) -> b -> a -> c
flip CdioErrorType -> String -> Either CdioError a
forall a. CdioErrorType -> String -> Either CdioError a
errorText String
"fail" (CdioErrorType -> Either CdioError a)
-> (Text -> CdioErrorType) -> Text -> Either CdioError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CdioErrorType
FreeformCdioError (Text -> Cdio a) -> Text -> Cdio a
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
e
instance N.E.MonadError CdioError Cdio where
    throwError :: CdioError -> Cdio a
throwError CdioError
err = (Cdio -> IO (Either CdioError a)) -> Cdio a
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError a)) -> Cdio a)
-> (Either CdioError a -> Cdio -> IO (Either CdioError a))
-> Either CdioError a
-> Cdio a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either CdioError a) -> Cdio -> IO (Either CdioError a)
forall a b. a -> b -> a
const (IO (Either CdioError a) -> Cdio -> IO (Either CdioError a))
-> (Either CdioError a -> IO (Either CdioError a))
-> Either CdioError a
-> Cdio
-> IO (Either CdioError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either CdioError a -> IO (Either CdioError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CdioError a -> Cdio a) -> Either CdioError a -> Cdio a
forall a b. (a -> b) -> a -> b
$ CdioError -> Either CdioError a
forall a b. a -> Either a b
Left CdioError
err
    catchError :: Cdio a -> (CdioError -> Cdio a) -> Cdio a
catchError (Cdio Cdio -> IO (Either CdioError a)
f) CdioError -> Cdio a
e = (Cdio -> IO (Either CdioError a)) -> Cdio a
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError a)) -> Cdio a)
-> (Cdio -> IO (Either CdioError a)) -> Cdio a
forall a b. (a -> b) -> a -> b
$ \Cdio
c -> Cdio -> IO (Either CdioError a)
f Cdio
c IO (Either CdioError a)
-> (Either CdioError a -> IO (Either CdioError a))
-> IO (Either CdioError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either CdioError a
a' -> case Either CdioError a
a' of
        Left CdioError
err ->
            let Cdio Cdio -> IO (Either CdioError a)
g = CdioError -> Cdio a
e CdioError
err
            in  Cdio -> IO (Either CdioError a)
g Cdio
c
        Right a
a -> Either CdioError a -> IO (Either CdioError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CdioError a -> IO (Either CdioError a))
-> Either CdioError a -> IO (Either CdioError a)
forall a b. (a -> b) -> a -> b
$ a -> Either CdioError a
forall a b. b -> Either a b
Right a
a
instance LibcdioLogger Cdio where
    logCutoff :: Cdio LogLevel
logCutoff = (Cdio -> IO (Either CdioError LogLevel)) -> Cdio LogLevel
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError LogLevel)) -> Cdio LogLevel)
-> (Cdio -> IO (Either CdioError LogLevel)) -> Cdio LogLevel
forall a b. (a -> b) -> a -> b
$ \Cdio
_ -> LogLevel -> Either CdioError LogLevel
forall a b. b -> Either a b
Right (LogLevel -> Either CdioError LogLevel)
-> IO LogLevel -> IO (Either CdioError LogLevel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO LogLevel
Foreign.logCutoff
    setLogCutoff :: LogLevel -> Cdio ()
setLogCutoff LogLevel
l = (Cdio -> IO (Either CdioError ())) -> Cdio ()
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError ())) -> Cdio ())
-> (Cdio -> IO (Either CdioError ())) -> Cdio ()
forall a b. (a -> b) -> a -> b
$ \Cdio
_ -> () -> Either CdioError ()
forall a b. b -> Either a b
Right (() -> Either CdioError ()) -> IO () -> IO (Either CdioError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LogLevel -> IO ()
Foreign.setLogCutoff LogLevel
l
    readLog :: Cdio [LogEntry]
readLog = (Cdio -> IO (Either CdioError [LogEntry])) -> Cdio [LogEntry]
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError [LogEntry])) -> Cdio [LogEntry])
-> (Cdio -> IO (Either CdioError [LogEntry])) -> Cdio [LogEntry]
forall a b. (a -> b) -> a -> b
$ \Cdio
_ -> [LogEntry] -> Either CdioError [LogEntry]
forall a b. b -> Either a b
Right ([LogEntry] -> Either CdioError [LogEntry])
-> IO [LogEntry] -> IO (Either CdioError [LogEntry])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [LogEntry]
Foreign.readLog
    clearLog :: Cdio ()
clearLog = (Cdio -> IO (Either CdioError ())) -> Cdio ()
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError ())) -> Cdio ())
-> (Cdio -> IO (Either CdioError ())) -> Cdio ()
forall a b. (a -> b) -> a -> b
$ \Cdio
_ -> () -> Either CdioError ()
forall a b. b -> Either a b
Right (() -> Either CdioError ()) -> IO () -> IO (Either CdioError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ()
Foreign.clearLog
    putLog :: LogEntry -> Cdio ()
putLog LogEntry
e = (Cdio -> IO (Either CdioError ())) -> Cdio ()
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError ())) -> Cdio ())
-> (Cdio -> IO (Either CdioError ())) -> Cdio ()
forall a b. (a -> b) -> a -> b
$ \Cdio
_ -> () -> Either CdioError ()
forall a b. b -> Either a b
Right (() -> Either CdioError ()) -> IO () -> IO (Either CdioError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LogEntry -> IO ()
Foreign.putLog LogEntry
e

-- | Lift a computation from the C-style "Foreign.Libcdio" interface into the
-- monadic "Sound.Libcdio".
liftCdio :: (Foreign.Cdio -> IO a) -> Cdio a
liftCdio :: (Cdio -> IO a) -> Cdio a
liftCdio Cdio -> IO a
f = (Cdio -> IO (Either CdioError a)) -> Cdio a
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError a)) -> Cdio a)
-> (Cdio -> IO (Either CdioError a)) -> Cdio a
forall a b. (a -> b) -> a -> b
$ (a -> Either CdioError a) -> IO a -> IO (Either CdioError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either CdioError a
forall a b. b -> Either a b
Right (IO a -> IO (Either CdioError a))
-> (Cdio -> IO a) -> Cdio -> IO (Either CdioError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cdio -> IO a
f

-- | As 'liftCdio', but for functions which take a second argument alongside
-- the read session.
liftCdio' :: (Foreign.Cdio -> a -> IO b) -> a -> Cdio b
liftCdio' :: (Cdio -> a -> IO b) -> a -> Cdio b
liftCdio' Cdio -> a -> IO b
f a
a = (Cdio -> IO (Either CdioError b)) -> Cdio b
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError b)) -> Cdio b)
-> (Cdio -> IO (Either CdioError b)) -> Cdio b
forall a b. (a -> b) -> a -> b
$ (b -> Either CdioError b) -> IO b -> IO (Either CdioError b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either CdioError b
forall a b. b -> Either a b
Right (IO b -> IO (Either CdioError b))
-> (Cdio -> IO b) -> Cdio -> IO (Either CdioError b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cdio -> a -> IO b) -> a -> Cdio -> IO b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Cdio -> a -> IO b
f a
a

-- | As 'liftCdio', but for functions which may return an error code indicating
-- failure.
liftCdioError :: (Foreign.Cdio -> IO (Either CdioError a)) -> Cdio a
{-# INLINE liftCdioError #-}
liftCdioError :: (Cdio -> IO (Either CdioError a)) -> Cdio a
liftCdioError = (Cdio -> IO (Either CdioError a)) -> Cdio a
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio

-- | As 'liftCdio'', but for functions which may return an error code indicating
-- failure.
liftCdioError' :: (Foreign.Cdio -> a -> IO (Either CdioError b)) -> a -> Cdio b
liftCdioError' :: (Cdio -> a -> IO (Either CdioError b)) -> a -> Cdio b
liftCdioError' Cdio -> a -> IO (Either CdioError b)
f a
a = (Cdio -> IO (Either CdioError b)) -> Cdio b
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
Cdio ((Cdio -> IO (Either CdioError b)) -> Cdio b)
-> (Cdio -> IO (Either CdioError b)) -> Cdio b
forall a b. (a -> b) -> a -> b
$ (Cdio -> a -> IO (Either CdioError b))
-> a -> Cdio -> IO (Either CdioError b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Cdio -> a -> IO (Either CdioError b)
f a
a


-- | Associates a well-typed error with human-readable context information.
data CdioError = CdioError CdioErrorType T.Text
  deriving ( CdioError -> CdioError -> Bool
(CdioError -> CdioError -> Bool)
-> (CdioError -> CdioError -> Bool) -> Eq CdioError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CdioError -> CdioError -> Bool
$c/= :: CdioError -> CdioError -> Bool
== :: CdioError -> CdioError -> Bool
$c== :: CdioError -> CdioError -> Bool
Eq, Int -> CdioError -> ShowS
[CdioError] -> ShowS
CdioError -> String
(Int -> CdioError -> ShowS)
-> (CdioError -> String)
-> ([CdioError] -> ShowS)
-> Show CdioError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CdioError] -> ShowS
$cshowList :: [CdioError] -> ShowS
show :: CdioError -> String
$cshow :: CdioError -> String
showsPrec :: Int -> CdioError -> ShowS
$cshowsPrec :: Int -> CdioError -> ShowS
Show, ReadPrec [CdioError]
ReadPrec CdioError
Int -> ReadS CdioError
ReadS [CdioError]
(Int -> ReadS CdioError)
-> ReadS [CdioError]
-> ReadPrec CdioError
-> ReadPrec [CdioError]
-> Read CdioError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CdioError]
$creadListPrec :: ReadPrec [CdioError]
readPrec :: ReadPrec CdioError
$creadPrec :: ReadPrec CdioError
readList :: ReadS [CdioError]
$creadList :: ReadS [CdioError]
readsPrec :: Int -> ReadS CdioError
$creadsPrec :: Int -> ReadS CdioError
Read )

-- | Potential situations which may cause a computation to fail.
data CdioErrorType
    = DriverError
        -- ^ A requested operation failed for some unknown reason, or the
        -- operating system doesn't support the 'Sound.Libcdio.Device.DriverId'
        -- in use.
    | BadParameter
        -- ^ Some value passed to a requested operation was rejected as
        -- nonsensical or otherwise breaking the value-level invariants.
    | NotPermitted
        -- ^ The ability to perform a requested operation has been restricted
        -- (e.g., the user doesn't have permission to access the disc drive).
    | SessionClosed
        -- ^ The underlying library closed the 'Cdio' session prematurely.
    | Unsupported
        -- ^ A requested operation isn't available with driver used by the
        -- 'Cdio' session.  Refer to 'Sound.Libcdio.Device.capabilities' and
        -- 'Sound.Libcdio.Device.deviceCapabilities' to reduce these.
    | CdioEmpty
        -- ^ 'A.empty' was called and no better alternative was encountered.
    | FreeformCdioError T.Text
        -- ^ Escape hatch from structured typing to allow user-specified
        -- (and user-triggered) errors.
  deriving ( CdioErrorType -> CdioErrorType -> Bool
(CdioErrorType -> CdioErrorType -> Bool)
-> (CdioErrorType -> CdioErrorType -> Bool) -> Eq CdioErrorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CdioErrorType -> CdioErrorType -> Bool
$c/= :: CdioErrorType -> CdioErrorType -> Bool
== :: CdioErrorType -> CdioErrorType -> Bool
$c== :: CdioErrorType -> CdioErrorType -> Bool
Eq, Int -> CdioErrorType -> ShowS
[CdioErrorType] -> ShowS
CdioErrorType -> String
(Int -> CdioErrorType -> ShowS)
-> (CdioErrorType -> String)
-> ([CdioErrorType] -> ShowS)
-> Show CdioErrorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CdioErrorType] -> ShowS
$cshowList :: [CdioErrorType] -> ShowS
show :: CdioErrorType -> String
$cshow :: CdioErrorType -> String
showsPrec :: Int -> CdioErrorType -> ShowS
$cshowsPrec :: Int -> CdioErrorType -> ShowS
Show, ReadPrec [CdioErrorType]
ReadPrec CdioErrorType
Int -> ReadS CdioErrorType
ReadS [CdioErrorType]
(Int -> ReadS CdioErrorType)
-> ReadS [CdioErrorType]
-> ReadPrec CdioErrorType
-> ReadPrec [CdioErrorType]
-> Read CdioErrorType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CdioErrorType]
$creadListPrec :: ReadPrec [CdioErrorType]
readPrec :: ReadPrec CdioErrorType
$creadPrec :: ReadPrec CdioErrorType
readList :: ReadS [CdioErrorType]
$creadList :: ReadS [CdioErrorType]
readsPrec :: Int -> ReadS CdioErrorType
$creadsPrec :: Int -> ReadS CdioErrorType
Read )

errorText :: CdioErrorType -> String -> Either CdioError a
errorText :: CdioErrorType -> String -> Either CdioError a
errorText CdioErrorType
e = CdioError -> Either CdioError a
forall a b. a -> Either a b
Left (CdioError -> Either CdioError a)
-> (String -> CdioError) -> String -> Either CdioError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CdioErrorType -> Text -> CdioError
CdioError CdioErrorType
e (Text -> CdioError) -> (String -> Text) -> String -> CdioError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

packCdioError :: String -> Foreign.DriverReturnCode -> a -> Either CdioError a
packCdioError :: String -> DriverReturnCode -> a -> Either CdioError a
packCdioError String
_ DriverReturnCode
Foreign.Success = a -> Either CdioError a
forall a b. b -> Either a b
Right
packCdioError String
s DriverReturnCode
Foreign.DriverError = Either CdioError a -> a -> Either CdioError a
forall a b. a -> b -> a
const (Either CdioError a -> a -> Either CdioError a)
-> Either CdioError a -> a -> Either CdioError a
forall a b. (a -> b) -> a -> b
$ CdioErrorType -> String -> Either CdioError a
forall a. CdioErrorType -> String -> Either CdioError a
errorText CdioErrorType
DriverError String
s
packCdioError String
s DriverReturnCode
Foreign.Unsupported = Either CdioError a -> a -> Either CdioError a
forall a b. a -> b -> a
const (Either CdioError a -> a -> Either CdioError a)
-> Either CdioError a -> a -> Either CdioError a
forall a b. (a -> b) -> a -> b
$ CdioErrorType -> String -> Either CdioError a
forall a. CdioErrorType -> String -> Either CdioError a
errorText CdioErrorType
Unsupported String
s
packCdioError String
s DriverReturnCode
Foreign.Uninitialized = Either CdioError a -> a -> Either CdioError a
forall a b. a -> b -> a
const (Either CdioError a -> a -> Either CdioError a)
-> Either CdioError a -> a -> Either CdioError a
forall a b. (a -> b) -> a -> b
$ CdioErrorType -> String -> Either CdioError a
forall a. CdioErrorType -> String -> Either CdioError a
errorText CdioErrorType
BadParameter String
s
packCdioError String
s DriverReturnCode
Foreign.NotPermitted = Either CdioError a -> a -> Either CdioError a
forall a b. a -> b -> a
const (Either CdioError a -> a -> Either CdioError a)
-> Either CdioError a -> a -> Either CdioError a
forall a b. (a -> b) -> a -> b
$ CdioErrorType -> String -> Either CdioError a
forall a. CdioErrorType -> String -> Either CdioError a
errorText CdioErrorType
NotPermitted String
s
packCdioError String
s DriverReturnCode
Foreign.BadParameter = Either CdioError a -> a -> Either CdioError a
forall a b. a -> b -> a
const (Either CdioError a -> a -> Either CdioError a)
-> Either CdioError a -> a -> Either CdioError a
forall a b. (a -> b) -> a -> b
$ CdioErrorType -> String -> Either CdioError a
forall a. CdioErrorType -> String -> Either CdioError a
errorText CdioErrorType
BadParameter String
s
packCdioError String
s DriverReturnCode
Foreign.BadPointer = Either CdioError a -> a -> Either CdioError a
forall a b. a -> b -> a
const (Either CdioError a -> a -> Either CdioError a)
-> Either CdioError a -> a -> Either CdioError a
forall a b. (a -> b) -> a -> b
$ CdioErrorType -> String -> Either CdioError a
forall a. CdioErrorType -> String -> Either CdioError a
errorText CdioErrorType
BadParameter String
s
packCdioError String
s DriverReturnCode
Foreign.NoDriver = Either CdioError a -> a -> Either CdioError a
forall a b. a -> b -> a
const (Either CdioError a -> a -> Either CdioError a)
-> Either CdioError a -> a -> Either CdioError a
forall a b. (a -> b) -> a -> b
$ CdioErrorType -> String -> Either CdioError a
forall a. CdioErrorType -> String -> Either CdioError a
errorText CdioErrorType
DriverError String
s
packCdioError String
_ DriverReturnCode
Foreign.MmcSenseData = a -> Either CdioError a
forall a b. b -> Either a b
Right

packCdioError' :: String -> Either Foreign.DriverReturnCode a -> Either CdioError a
packCdioError' :: String -> Either DriverReturnCode a -> Either CdioError a
packCdioError' String
_ (Right a
a) = a -> Either CdioError a
forall a b. b -> Either a b
Right a
a
packCdioError' String
s (Left DriverReturnCode
Foreign.Success) = CdioErrorType -> String -> Either CdioError a
forall a. CdioErrorType -> String -> Either CdioError a
errorText CdioErrorType
DriverError String
s
packCdioError' String
s (Left DriverReturnCode
e) = String -> DriverReturnCode -> a -> Either CdioError a
forall a. String -> DriverReturnCode -> a -> Either CdioError a
packCdioError String
s DriverReturnCode
e a
forall a. HasCallStack => a
undefined


-- | Use a C-style @"Foreign.Libcdio".'Foreign.Cdio'@ object as the base to run
-- a Haskell-style @"Sound.Libcdio".'Cdio'@ computation.
-- 
-- Note that some invariants of the monadic interface may not work as expected
-- when used with the mutable objects.
runCdio :: Foreign.Cdio -> Cdio a -> IO (Either CdioError a)
runCdio :: Cdio -> Cdio a -> IO (Either CdioError a)
runCdio Cdio
c (Cdio Cdio -> IO (Either CdioError a)
f) = IO (Either CdioError a) -> IO (Either CdioError a)
forall (m :: * -> *) a. (Monad m, LibcdioLogger m) => m a -> m a
isolateLogs (IO (Either CdioError a) -> IO (Either CdioError a))
-> IO (Either CdioError a) -> IO (Either CdioError a)
forall a b. (a -> b) -> a -> b
$ Cdio -> IO (Either CdioError a)
f Cdio
c


-- | Open a session to read data from the disc drive/image at the given
-- location.  If passed 'Nothing' instead, uses the path considered "default";
-- on operating systems with a concept of numbered devices (e.g., Window's @D:@
-- drive, FreeBSD's @\/dev\/cd0@) will usually return the first such device
-- found to be suitable.
open
    :: Maybe FilePath
    -> Bool
        -- ^ Whether the disc should be ejected after the computation.
    -> Cdio a
    -> IO (Either CdioError a)
open :: Maybe String -> Bool -> Cdio a -> IO (Either CdioError a)
open = String
-> Maybe AccessMode
-> Maybe String
-> Bool
-> Cdio a
-> IO (Either CdioError a)
forall a.
String
-> Maybe AccessMode
-> Maybe String
-> Bool
-> Cdio a
-> IO (Either CdioError a)
open' String
"open" Maybe AccessMode
forall a. Maybe a
Nothing


-- | Open a session to read data from the disc drive/image at the given
-- location, using a specific instruction set.  If passed 'Nothing' instead,
-- uses the path considered "default"; on operating systems with a concept of
-- numbered devices (e.g., Window's @D:@ drive, FreeBSD's @\/dev\/cd0@) will
-- usually return the first such device found to be suitable.
openMode
    :: Foreign.AccessMode
    -> Maybe FilePath
    -> Bool
        -- ^ Whether the disc should be ejected after the computation.
    -> Cdio a
    -> IO (Either CdioError a)
openMode :: AccessMode
-> Maybe String -> Bool -> Cdio a -> IO (Either CdioError a)
openMode = String
-> Maybe AccessMode
-> Maybe String
-> Bool
-> Cdio a
-> IO (Either CdioError a)
forall a.
String
-> Maybe AccessMode
-> Maybe String
-> Bool
-> Cdio a
-> IO (Either CdioError a)
open' String
"openMode" (Maybe AccessMode
 -> Maybe String -> Bool -> Cdio a -> IO (Either CdioError a))
-> (AccessMode -> Maybe AccessMode)
-> AccessMode
-> Maybe String
-> Bool
-> Cdio a
-> IO (Either CdioError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccessMode -> Maybe AccessMode
forall a. a -> Maybe a
Just


open'
    :: String
        -- ^ The name of the calling function, for error reporting.
    -> Maybe Foreign.AccessMode
    -> Maybe FilePath
    -> Bool
        -- ^ Whether the disc should be ejected after the computation.
    -> Cdio a
    -> IO (Either CdioError a)
open' :: String
-> Maybe AccessMode
-> Maybe String
-> Bool
-> Cdio a
-> IO (Either CdioError a)
open' String
s Maybe AccessMode
m Maybe String
p Bool
e (Cdio Cdio -> IO (Either CdioError a)
f) = IO (Either CdioError a) -> IO (Either CdioError a)
forall (m :: * -> *) a. (Monad m, LibcdioLogger m) => m a -> m a
isolateLogs (IO (Either CdioError a) -> IO (Either CdioError a))
-> IO (Either CdioError a) -> IO (Either CdioError a)
forall a b. (a -> b) -> a -> b
$ do
    -- Rely on the driver autodetect behaviour.
    Maybe Cdio
c <-  case Maybe AccessMode
m of
        Just AccessMode
m' -> Maybe String -> DriverId -> AccessMode -> IO (Maybe Cdio)
Foreign.cdioOpenAm Maybe String
p DriverId
Foreign.DriverUnknown AccessMode
m'
        Maybe AccessMode
Nothing -> Maybe String -> DriverId -> IO (Maybe Cdio)
Foreign.cdioOpen Maybe String
p DriverId
Foreign.DriverUnknown
    case Maybe Cdio
c of
        Just Cdio
c' -> do
            Either CdioError a
a <- Cdio -> IO (Either CdioError a)
f Cdio
c'
            -- This isn't actually necessary since the failure code is ignored,
            -- but it's a small cost to be sure nothing weird happens (e.g.
            -- printing a warning message).
            (DriveReadCaps
_, DriveWriteCaps
_, DriveMiscCaps
cap) <- Cdio -> IO (DriveReadCaps, DriveWriteCaps, DriveMiscCaps)
Foreign.driveCap Cdio
c'
            let e' :: IO DriverReturnCode
e' = if Bool
e Bool -> Bool -> Bool
&& DriveMiscCaps
cap DriveMiscCaps -> DriveCapabilityMisc -> Bool
forall i. Ix i => BitArray i -> i -> Bool
! DriveCapabilityMisc
Foreign.MiscEject
                then Cdio -> IO DriverReturnCode
Foreign.ejectMedia Cdio
c'
                else DriverReturnCode -> IO DriverReturnCode
forall (m :: * -> *) a. Monad m => a -> m a
return DriverReturnCode
Foreign.Success
            IO DriverReturnCode
e' IO DriverReturnCode
-> IO (Either CdioError a) -> IO (Either CdioError a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either CdioError a -> IO (Either CdioError a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either CdioError a
a
        -- There may be a chance memory allocation fails, but far and away the
        -- most common is a path which is not actually a device.
        Maybe Cdio
Nothing -> do
            Either CdioError a -> IO (Either CdioError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CdioError a -> IO (Either CdioError a))
-> Either CdioError a -> IO (Either CdioError a)
forall a b. (a -> b) -> a -> b
$ CdioErrorType -> String -> Either CdioError a
forall a. CdioErrorType -> String -> Either CdioError a
errorText CdioErrorType
BadParameter String
s


-- | Retrieve the session value associated with the given key.  The particular
-- case of @"access-mode"@ is instead handled by 'getAccessMode'.
getArg :: Foreign.SessionArg -> Cdio (Maybe T.Text)
getArg :: SessionArg -> Cdio (Maybe Text)
getArg SessionArg
k = (Cdio -> IO (Maybe Text)) -> Cdio (Maybe Text)
forall a. (Cdio -> IO a) -> Cdio a
liftCdio ((Cdio -> IO (Maybe Text)) -> Cdio (Maybe Text))
-> (Cdio -> IO (Maybe Text)) -> Cdio (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Cdio
c -> do
    Maybe String
v <- Cdio -> SessionArg -> IO (Maybe String)
Foreign.getArg Cdio
c SessionArg
k
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
v

-- | Check what instruction set is in use for reading the disc.  Other session
-- values are handled by 'getArg'.
getAccessMode :: Cdio (Maybe Foreign.AccessMode)
getAccessMode :: Cdio (Maybe AccessMode)
getAccessMode = (Cdio -> IO (Maybe AccessMode)) -> Cdio (Maybe AccessMode)
forall a. (Cdio -> IO a) -> Cdio a
liftCdio Cdio -> IO (Maybe AccessMode)
Foreign.getAccessMode