-- |
-- Module      :  Codec.Audio.FLAC.StreamEncoder.Internal.Types
-- Copyright   :  © 2016–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Mostly non-public stream encoder-specific helper types.
module Codec.Audio.FLAC.StreamEncoder.Internal.Types
  ( Encoder (..),
    EncoderInitStatus (..),
    EncoderState (..),
    EncoderException (..),
    ApodizationFunction (..),
  )
where

import Codec.Audio.Wave (SampleFormat)
import Control.Exception
import Data.Void
import Foreign
import Numeric.Natural

-- | An opaque newtype wrapper around @'Ptr' 'Void'@, serves to represent a
-- pointer to an encoder instance.
newtype Encoder = Encoder (Ptr Void)

-- | Status of encoder initialization process.
data EncoderInitStatus
  = -- | Initialization was successful.
    EncoderInitStatusOK
  | -- | General failure to set up encoder.
    EncoderInitStatusEncoderError
  | -- | The library was not compiled with support for the given container
    -- format.
    EncoderInitStatusUnsupportedCointainer
  | -- | A required callback was not supplied.
    EncoderInitStatusInvalidCallbacks
  | -- | The encoder has an invalid setting for the number of channels.
    EncoderInitStatusInvalidNumberOfChannels
  | -- | The encoder has an invalid setting for the bits-per-sample. FLAC
    -- supports 4-32 bps but the reference encoder currently supports only
    -- up to 24 bps.
    EncoderInitStatusInvalidBitsPerSample
  | -- | The encoder has an invalid setting for the sample rate.
    EncoderInitStatusInvalidSampleRate
  | -- | The encoder has an invalid setting for the block size.
    EncoderInitStatusInvalidBlockSize
  | -- | The encoder has an invalid setting for the maximum LPC order.
    EncoderInitStatusInvalidMaxLpcOrder
  | -- | The encoder has an invalid setting for the precision of the
    -- quantized linear predictor coefficients.
    EncoderInitStatusInvalidQlpCoeffPrecision
  | -- | The specified block size is less than the maximum LPC order.
    EncoderInitStatusBlockSizeTooSmallForLpcOrder
  | -- | The encoder is bound to the Subset but other settings violate it.
    EncoderInitStatusNotStreamable
  | -- | The metadata input to the encoder is invalid (should never happen
    -- with this binding).
    EncoderInitStatusInvalidMetadata
  | -- | Initialization was attempted on already initialized encoder.
    EncoderInitStatusAlreadyInitialized
  deriving (Int -> EncoderInitStatus -> ShowS
[EncoderInitStatus] -> ShowS
EncoderInitStatus -> String
(Int -> EncoderInitStatus -> ShowS)
-> (EncoderInitStatus -> String)
-> ([EncoderInitStatus] -> ShowS)
-> Show EncoderInitStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncoderInitStatus] -> ShowS
$cshowList :: [EncoderInitStatus] -> ShowS
show :: EncoderInitStatus -> String
$cshow :: EncoderInitStatus -> String
showsPrec :: Int -> EncoderInitStatus -> ShowS
$cshowsPrec :: Int -> EncoderInitStatus -> ShowS
Show, ReadPrec [EncoderInitStatus]
ReadPrec EncoderInitStatus
Int -> ReadS EncoderInitStatus
ReadS [EncoderInitStatus]
(Int -> ReadS EncoderInitStatus)
-> ReadS [EncoderInitStatus]
-> ReadPrec EncoderInitStatus
-> ReadPrec [EncoderInitStatus]
-> Read EncoderInitStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EncoderInitStatus]
$creadListPrec :: ReadPrec [EncoderInitStatus]
readPrec :: ReadPrec EncoderInitStatus
$creadPrec :: ReadPrec EncoderInitStatus
readList :: ReadS [EncoderInitStatus]
$creadList :: ReadS [EncoderInitStatus]
readsPrec :: Int -> ReadS EncoderInitStatus
$creadsPrec :: Int -> ReadS EncoderInitStatus
Read, EncoderInitStatus -> EncoderInitStatus -> Bool
(EncoderInitStatus -> EncoderInitStatus -> Bool)
-> (EncoderInitStatus -> EncoderInitStatus -> Bool)
-> Eq EncoderInitStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncoderInitStatus -> EncoderInitStatus -> Bool
$c/= :: EncoderInitStatus -> EncoderInitStatus -> Bool
== :: EncoderInitStatus -> EncoderInitStatus -> Bool
$c== :: EncoderInitStatus -> EncoderInitStatus -> Bool
Eq, Eq EncoderInitStatus
Eq EncoderInitStatus =>
(EncoderInitStatus -> EncoderInitStatus -> Ordering)
-> (EncoderInitStatus -> EncoderInitStatus -> Bool)
-> (EncoderInitStatus -> EncoderInitStatus -> Bool)
-> (EncoderInitStatus -> EncoderInitStatus -> Bool)
-> (EncoderInitStatus -> EncoderInitStatus -> Bool)
-> (EncoderInitStatus -> EncoderInitStatus -> EncoderInitStatus)
-> (EncoderInitStatus -> EncoderInitStatus -> EncoderInitStatus)
-> Ord EncoderInitStatus
EncoderInitStatus -> EncoderInitStatus -> Bool
EncoderInitStatus -> EncoderInitStatus -> Ordering
EncoderInitStatus -> EncoderInitStatus -> EncoderInitStatus
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EncoderInitStatus -> EncoderInitStatus -> EncoderInitStatus
$cmin :: EncoderInitStatus -> EncoderInitStatus -> EncoderInitStatus
max :: EncoderInitStatus -> EncoderInitStatus -> EncoderInitStatus
$cmax :: EncoderInitStatus -> EncoderInitStatus -> EncoderInitStatus
>= :: EncoderInitStatus -> EncoderInitStatus -> Bool
$c>= :: EncoderInitStatus -> EncoderInitStatus -> Bool
> :: EncoderInitStatus -> EncoderInitStatus -> Bool
$c> :: EncoderInitStatus -> EncoderInitStatus -> Bool
<= :: EncoderInitStatus -> EncoderInitStatus -> Bool
$c<= :: EncoderInitStatus -> EncoderInitStatus -> Bool
< :: EncoderInitStatus -> EncoderInitStatus -> Bool
$c< :: EncoderInitStatus -> EncoderInitStatus -> Bool
compare :: EncoderInitStatus -> EncoderInitStatus -> Ordering
$ccompare :: EncoderInitStatus -> EncoderInitStatus -> Ordering
$cp1Ord :: Eq EncoderInitStatus
Ord, EncoderInitStatus
EncoderInitStatus -> EncoderInitStatus -> Bounded EncoderInitStatus
forall a. a -> a -> Bounded a
maxBound :: EncoderInitStatus
$cmaxBound :: EncoderInitStatus
minBound :: EncoderInitStatus
$cminBound :: EncoderInitStatus
Bounded, Int -> EncoderInitStatus
EncoderInitStatus -> Int
EncoderInitStatus -> [EncoderInitStatus]
EncoderInitStatus -> EncoderInitStatus
EncoderInitStatus -> EncoderInitStatus -> [EncoderInitStatus]
EncoderInitStatus
-> EncoderInitStatus -> EncoderInitStatus -> [EncoderInitStatus]
(EncoderInitStatus -> EncoderInitStatus)
-> (EncoderInitStatus -> EncoderInitStatus)
-> (Int -> EncoderInitStatus)
-> (EncoderInitStatus -> Int)
-> (EncoderInitStatus -> [EncoderInitStatus])
-> (EncoderInitStatus -> EncoderInitStatus -> [EncoderInitStatus])
-> (EncoderInitStatus -> EncoderInitStatus -> [EncoderInitStatus])
-> (EncoderInitStatus
    -> EncoderInitStatus -> EncoderInitStatus -> [EncoderInitStatus])
-> Enum EncoderInitStatus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EncoderInitStatus
-> EncoderInitStatus -> EncoderInitStatus -> [EncoderInitStatus]
$cenumFromThenTo :: EncoderInitStatus
-> EncoderInitStatus -> EncoderInitStatus -> [EncoderInitStatus]
enumFromTo :: EncoderInitStatus -> EncoderInitStatus -> [EncoderInitStatus]
$cenumFromTo :: EncoderInitStatus -> EncoderInitStatus -> [EncoderInitStatus]
enumFromThen :: EncoderInitStatus -> EncoderInitStatus -> [EncoderInitStatus]
$cenumFromThen :: EncoderInitStatus -> EncoderInitStatus -> [EncoderInitStatus]
enumFrom :: EncoderInitStatus -> [EncoderInitStatus]
$cenumFrom :: EncoderInitStatus -> [EncoderInitStatus]
fromEnum :: EncoderInitStatus -> Int
$cfromEnum :: EncoderInitStatus -> Int
toEnum :: Int -> EncoderInitStatus
$ctoEnum :: Int -> EncoderInitStatus
pred :: EncoderInitStatus -> EncoderInitStatus
$cpred :: EncoderInitStatus -> EncoderInitStatus
succ :: EncoderInitStatus -> EncoderInitStatus
$csucc :: EncoderInitStatus -> EncoderInitStatus
Enum)

-- | Enumeration of encoder states.
data EncoderState
  = -- | The encoder is in the normal OK state and samples can be processed.
    EncoderStateOK
  | -- | The encoder is in the uninitialized state.
    EncoderStateUninitialized
  | -- | An error occurred in the underlying Ogg layer.
    EncoderStateOggError
  | -- | An error occurred in the underlying verify stream decoder.
    EncoderStateVerifyDecoderError
  | -- | The verify decoder detected a mismatch between the original audio
    -- signal and the decoded audio signal.
    EncoderStateVerifyMismatchInAudioData
  | -- | One of the callbacks returned a fatal error.
    EncoderStateClientError
  | -- | An I\/O error occurred while opening\/reading\/writing a file.
    EncoderStateIOError
  | -- | An error occurred while writing the stream.
    EncoderStateFramingError
  | -- | Memory allocation failed.
    EncoderStateMemoryAllocationError
  deriving (Int -> EncoderState -> ShowS
[EncoderState] -> ShowS
EncoderState -> String
(Int -> EncoderState -> ShowS)
-> (EncoderState -> String)
-> ([EncoderState] -> ShowS)
-> Show EncoderState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncoderState] -> ShowS
$cshowList :: [EncoderState] -> ShowS
show :: EncoderState -> String
$cshow :: EncoderState -> String
showsPrec :: Int -> EncoderState -> ShowS
$cshowsPrec :: Int -> EncoderState -> ShowS
Show, ReadPrec [EncoderState]
ReadPrec EncoderState
Int -> ReadS EncoderState
ReadS [EncoderState]
(Int -> ReadS EncoderState)
-> ReadS [EncoderState]
-> ReadPrec EncoderState
-> ReadPrec [EncoderState]
-> Read EncoderState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EncoderState]
$creadListPrec :: ReadPrec [EncoderState]
readPrec :: ReadPrec EncoderState
$creadPrec :: ReadPrec EncoderState
readList :: ReadS [EncoderState]
$creadList :: ReadS [EncoderState]
readsPrec :: Int -> ReadS EncoderState
$creadsPrec :: Int -> ReadS EncoderState
Read, EncoderState -> EncoderState -> Bool
(EncoderState -> EncoderState -> Bool)
-> (EncoderState -> EncoderState -> Bool) -> Eq EncoderState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncoderState -> EncoderState -> Bool
$c/= :: EncoderState -> EncoderState -> Bool
== :: EncoderState -> EncoderState -> Bool
$c== :: EncoderState -> EncoderState -> Bool
Eq, Eq EncoderState
Eq EncoderState =>
(EncoderState -> EncoderState -> Ordering)
-> (EncoderState -> EncoderState -> Bool)
-> (EncoderState -> EncoderState -> Bool)
-> (EncoderState -> EncoderState -> Bool)
-> (EncoderState -> EncoderState -> Bool)
-> (EncoderState -> EncoderState -> EncoderState)
-> (EncoderState -> EncoderState -> EncoderState)
-> Ord EncoderState
EncoderState -> EncoderState -> Bool
EncoderState -> EncoderState -> Ordering
EncoderState -> EncoderState -> EncoderState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EncoderState -> EncoderState -> EncoderState
$cmin :: EncoderState -> EncoderState -> EncoderState
max :: EncoderState -> EncoderState -> EncoderState
$cmax :: EncoderState -> EncoderState -> EncoderState
>= :: EncoderState -> EncoderState -> Bool
$c>= :: EncoderState -> EncoderState -> Bool
> :: EncoderState -> EncoderState -> Bool
$c> :: EncoderState -> EncoderState -> Bool
<= :: EncoderState -> EncoderState -> Bool
$c<= :: EncoderState -> EncoderState -> Bool
< :: EncoderState -> EncoderState -> Bool
$c< :: EncoderState -> EncoderState -> Bool
compare :: EncoderState -> EncoderState -> Ordering
$ccompare :: EncoderState -> EncoderState -> Ordering
$cp1Ord :: Eq EncoderState
Ord, EncoderState
EncoderState -> EncoderState -> Bounded EncoderState
forall a. a -> a -> Bounded a
maxBound :: EncoderState
$cmaxBound :: EncoderState
minBound :: EncoderState
$cminBound :: EncoderState
Bounded, Int -> EncoderState
EncoderState -> Int
EncoderState -> [EncoderState]
EncoderState -> EncoderState
EncoderState -> EncoderState -> [EncoderState]
EncoderState -> EncoderState -> EncoderState -> [EncoderState]
(EncoderState -> EncoderState)
-> (EncoderState -> EncoderState)
-> (Int -> EncoderState)
-> (EncoderState -> Int)
-> (EncoderState -> [EncoderState])
-> (EncoderState -> EncoderState -> [EncoderState])
-> (EncoderState -> EncoderState -> [EncoderState])
-> (EncoderState -> EncoderState -> EncoderState -> [EncoderState])
-> Enum EncoderState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EncoderState -> EncoderState -> EncoderState -> [EncoderState]
$cenumFromThenTo :: EncoderState -> EncoderState -> EncoderState -> [EncoderState]
enumFromTo :: EncoderState -> EncoderState -> [EncoderState]
$cenumFromTo :: EncoderState -> EncoderState -> [EncoderState]
enumFromThen :: EncoderState -> EncoderState -> [EncoderState]
$cenumFromThen :: EncoderState -> EncoderState -> [EncoderState]
enumFrom :: EncoderState -> [EncoderState]
$cenumFrom :: EncoderState -> [EncoderState]
fromEnum :: EncoderState -> Int
$cfromEnum :: EncoderState -> Int
toEnum :: Int -> EncoderState
$ctoEnum :: Int -> EncoderState
pred :: EncoderState -> EncoderState
$cpred :: EncoderState -> EncoderState
succ :: EncoderState -> EncoderState
$csucc :: EncoderState -> EncoderState
Enum)

-- | Exception that is thrown when encoding fails for some reason.
data EncoderException
  = -- | Input WAVE file had this sample format, which is not supported
    -- (usually happens with floating point samples right now).
    EncoderInvalidSampleFormat SampleFormat
  | -- | Encoder initialization failed.
    EncoderInitFailed EncoderInitStatus
  | -- | Encoder failed.
    EncoderFailed EncoderState
  deriving (EncoderException -> EncoderException -> Bool
(EncoderException -> EncoderException -> Bool)
-> (EncoderException -> EncoderException -> Bool)
-> Eq EncoderException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncoderException -> EncoderException -> Bool
$c/= :: EncoderException -> EncoderException -> Bool
== :: EncoderException -> EncoderException -> Bool
$c== :: EncoderException -> EncoderException -> Bool
Eq, Int -> EncoderException -> ShowS
[EncoderException] -> ShowS
EncoderException -> String
(Int -> EncoderException -> ShowS)
-> (EncoderException -> String)
-> ([EncoderException] -> ShowS)
-> Show EncoderException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncoderException] -> ShowS
$cshowList :: [EncoderException] -> ShowS
show :: EncoderException -> String
$cshow :: EncoderException -> String
showsPrec :: Int -> EncoderException -> ShowS
$cshowsPrec :: Int -> EncoderException -> ShowS
Show, ReadPrec [EncoderException]
ReadPrec EncoderException
Int -> ReadS EncoderException
ReadS [EncoderException]
(Int -> ReadS EncoderException)
-> ReadS [EncoderException]
-> ReadPrec EncoderException
-> ReadPrec [EncoderException]
-> Read EncoderException
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EncoderException]
$creadListPrec :: ReadPrec [EncoderException]
readPrec :: ReadPrec EncoderException
$creadPrec :: ReadPrec EncoderException
readList :: ReadS [EncoderException]
$creadList :: ReadS [EncoderException]
readsPrec :: Int -> ReadS EncoderException
$creadsPrec :: Int -> ReadS EncoderException
Read)

instance Exception EncoderException

-- | Supported apodization functions.
data ApodizationFunction
  = Bartlett
  | BartlettHann
  | Blackman
  | BlackmanHarris4Term92Db
  | Connes
  | Flattop
  | -- | The parameter is standard deviation @STDDEV@, @0 < STDDEV <= 0.5@.
    Gauss Double
  | Hamming
  | Hann
  | KaiserBessel
  | Nuttall
  | Rectangle
  | Triangle
  | -- | The parameter is the fraction of the window that is tapered @P@,
    -- @0 <= P <= 1@. @P == 0@ corresponds to 'Rectangle' and @P = 1@
    -- corresponds to 'Hann'.
    Tukey Double
  | -- | The parameters are a series of small windows (all treated
    -- separately). The three parameters are @n@, @ov@ and @P@. @n@ is the
    -- number of functions to add, @ov@ is the overlap of the windows. @P@
    -- is the fraction of the window that is tapered, like with a regular
    -- tukey window. The function can be specified with only a number, a
    -- number and an overlap, or a number, an overlap and a @P@. @ov@ should
    -- be smaller than 1 and can be negative.
    PartialTukey Natural (Maybe (Double, Maybe Double))
  | -- | The parameters are a series of windows that have a hole in them. In
    -- this way, the predictor is constructed with only a part of the block,
    -- which helps in case a block consists of dissimilar parts. All said
    -- about the parameters in the comment for 'PartialTukey' applies here,
    -- with the exception that @ov@ is the overlap in the gaps in this case.
    PunchoutTukey Natural (Maybe (Double, Maybe Double))
  | Welch
  deriving (ApodizationFunction -> ApodizationFunction -> Bool
(ApodizationFunction -> ApodizationFunction -> Bool)
-> (ApodizationFunction -> ApodizationFunction -> Bool)
-> Eq ApodizationFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApodizationFunction -> ApodizationFunction -> Bool
$c/= :: ApodizationFunction -> ApodizationFunction -> Bool
== :: ApodizationFunction -> ApodizationFunction -> Bool
$c== :: ApodizationFunction -> ApodizationFunction -> Bool
Eq, Int -> ApodizationFunction -> ShowS
[ApodizationFunction] -> ShowS
ApodizationFunction -> String
(Int -> ApodizationFunction -> ShowS)
-> (ApodizationFunction -> String)
-> ([ApodizationFunction] -> ShowS)
-> Show ApodizationFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApodizationFunction] -> ShowS
$cshowList :: [ApodizationFunction] -> ShowS
show :: ApodizationFunction -> String
$cshow :: ApodizationFunction -> String
showsPrec :: Int -> ApodizationFunction -> ShowS
$cshowsPrec :: Int -> ApodizationFunction -> ShowS
Show, ReadPrec [ApodizationFunction]
ReadPrec ApodizationFunction
Int -> ReadS ApodizationFunction
ReadS [ApodizationFunction]
(Int -> ReadS ApodizationFunction)
-> ReadS [ApodizationFunction]
-> ReadPrec ApodizationFunction
-> ReadPrec [ApodizationFunction]
-> Read ApodizationFunction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApodizationFunction]
$creadListPrec :: ReadPrec [ApodizationFunction]
readPrec :: ReadPrec ApodizationFunction
$creadPrec :: ReadPrec ApodizationFunction
readList :: ReadS [ApodizationFunction]
$creadList :: ReadS [ApodizationFunction]
readsPrec :: Int -> ReadS ApodizationFunction
$creadsPrec :: Int -> ReadS ApodizationFunction
Read, Eq ApodizationFunction
Eq ApodizationFunction =>
(ApodizationFunction -> ApodizationFunction -> Ordering)
-> (ApodizationFunction -> ApodizationFunction -> Bool)
-> (ApodizationFunction -> ApodizationFunction -> Bool)
-> (ApodizationFunction -> ApodizationFunction -> Bool)
-> (ApodizationFunction -> ApodizationFunction -> Bool)
-> (ApodizationFunction
    -> ApodizationFunction -> ApodizationFunction)
-> (ApodizationFunction
    -> ApodizationFunction -> ApodizationFunction)
-> Ord ApodizationFunction
ApodizationFunction -> ApodizationFunction -> Bool
ApodizationFunction -> ApodizationFunction -> Ordering
ApodizationFunction -> ApodizationFunction -> ApodizationFunction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ApodizationFunction -> ApodizationFunction -> ApodizationFunction
$cmin :: ApodizationFunction -> ApodizationFunction -> ApodizationFunction
max :: ApodizationFunction -> ApodizationFunction -> ApodizationFunction
$cmax :: ApodizationFunction -> ApodizationFunction -> ApodizationFunction
>= :: ApodizationFunction -> ApodizationFunction -> Bool
$c>= :: ApodizationFunction -> ApodizationFunction -> Bool
> :: ApodizationFunction -> ApodizationFunction -> Bool
$c> :: ApodizationFunction -> ApodizationFunction -> Bool
<= :: ApodizationFunction -> ApodizationFunction -> Bool
$c<= :: ApodizationFunction -> ApodizationFunction -> Bool
< :: ApodizationFunction -> ApodizationFunction -> Bool
$c< :: ApodizationFunction -> ApodizationFunction -> Bool
compare :: ApodizationFunction -> ApodizationFunction -> Ordering
$ccompare :: ApodizationFunction -> ApodizationFunction -> Ordering
$cp1Ord :: Eq ApodizationFunction
Ord)