-- |
-- Module      :  Codec.Audio.FLAC.StreamDecoder.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 decoder-specific helper types.
module Codec.Audio.FLAC.StreamDecoder.Internal.Types
  ( Decoder (..),
    DecoderInitStatus (..),
    DecoderState (..),
    DecoderException (..),
    ChannelAssignment (..),
  )
where

import Control.Exception
import Data.Void
import Foreign

-- | An opaque newtype wrapper around @'Ptr' 'Void'@, serves to represent
-- point to decoder instance.
newtype Decoder = Decoder (Ptr Void)

-- | Status of decoder initialization process.
data DecoderInitStatus
  = -- | Initialization was successful.
    DecoderInitStatusOK
  | -- | The library was not compiled with support for the given container
    -- format.
    DecoderInitStatusUnsupportedContainer
  | -- | A required callback was not supplied.
    DecoderInitStatusInvalidCallbacks
  | -- | An error occurred allocating memory.
    DecoderInitStatusMemoryAllocationError
  | -- | fopen() failed.
    DecoderInitStatusErrorOpeningFile
  | -- | Initialization was attempted on already initialized decoder.
    DecoderInitStatusAlreadyInitialized
  deriving (Int -> DecoderInitStatus -> ShowS
[DecoderInitStatus] -> ShowS
DecoderInitStatus -> String
(Int -> DecoderInitStatus -> ShowS)
-> (DecoderInitStatus -> String)
-> ([DecoderInitStatus] -> ShowS)
-> Show DecoderInitStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecoderInitStatus] -> ShowS
$cshowList :: [DecoderInitStatus] -> ShowS
show :: DecoderInitStatus -> String
$cshow :: DecoderInitStatus -> String
showsPrec :: Int -> DecoderInitStatus -> ShowS
$cshowsPrec :: Int -> DecoderInitStatus -> ShowS
Show, ReadPrec [DecoderInitStatus]
ReadPrec DecoderInitStatus
Int -> ReadS DecoderInitStatus
ReadS [DecoderInitStatus]
(Int -> ReadS DecoderInitStatus)
-> ReadS [DecoderInitStatus]
-> ReadPrec DecoderInitStatus
-> ReadPrec [DecoderInitStatus]
-> Read DecoderInitStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DecoderInitStatus]
$creadListPrec :: ReadPrec [DecoderInitStatus]
readPrec :: ReadPrec DecoderInitStatus
$creadPrec :: ReadPrec DecoderInitStatus
readList :: ReadS [DecoderInitStatus]
$creadList :: ReadS [DecoderInitStatus]
readsPrec :: Int -> ReadS DecoderInitStatus
$creadsPrec :: Int -> ReadS DecoderInitStatus
Read, DecoderInitStatus -> DecoderInitStatus -> Bool
(DecoderInitStatus -> DecoderInitStatus -> Bool)
-> (DecoderInitStatus -> DecoderInitStatus -> Bool)
-> Eq DecoderInitStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecoderInitStatus -> DecoderInitStatus -> Bool
$c/= :: DecoderInitStatus -> DecoderInitStatus -> Bool
== :: DecoderInitStatus -> DecoderInitStatus -> Bool
$c== :: DecoderInitStatus -> DecoderInitStatus -> Bool
Eq, Eq DecoderInitStatus
Eq DecoderInitStatus =>
(DecoderInitStatus -> DecoderInitStatus -> Ordering)
-> (DecoderInitStatus -> DecoderInitStatus -> Bool)
-> (DecoderInitStatus -> DecoderInitStatus -> Bool)
-> (DecoderInitStatus -> DecoderInitStatus -> Bool)
-> (DecoderInitStatus -> DecoderInitStatus -> Bool)
-> (DecoderInitStatus -> DecoderInitStatus -> DecoderInitStatus)
-> (DecoderInitStatus -> DecoderInitStatus -> DecoderInitStatus)
-> Ord DecoderInitStatus
DecoderInitStatus -> DecoderInitStatus -> Bool
DecoderInitStatus -> DecoderInitStatus -> Ordering
DecoderInitStatus -> DecoderInitStatus -> DecoderInitStatus
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 :: DecoderInitStatus -> DecoderInitStatus -> DecoderInitStatus
$cmin :: DecoderInitStatus -> DecoderInitStatus -> DecoderInitStatus
max :: DecoderInitStatus -> DecoderInitStatus -> DecoderInitStatus
$cmax :: DecoderInitStatus -> DecoderInitStatus -> DecoderInitStatus
>= :: DecoderInitStatus -> DecoderInitStatus -> Bool
$c>= :: DecoderInitStatus -> DecoderInitStatus -> Bool
> :: DecoderInitStatus -> DecoderInitStatus -> Bool
$c> :: DecoderInitStatus -> DecoderInitStatus -> Bool
<= :: DecoderInitStatus -> DecoderInitStatus -> Bool
$c<= :: DecoderInitStatus -> DecoderInitStatus -> Bool
< :: DecoderInitStatus -> DecoderInitStatus -> Bool
$c< :: DecoderInitStatus -> DecoderInitStatus -> Bool
compare :: DecoderInitStatus -> DecoderInitStatus -> Ordering
$ccompare :: DecoderInitStatus -> DecoderInitStatus -> Ordering
$cp1Ord :: Eq DecoderInitStatus
Ord, DecoderInitStatus
DecoderInitStatus -> DecoderInitStatus -> Bounded DecoderInitStatus
forall a. a -> a -> Bounded a
maxBound :: DecoderInitStatus
$cmaxBound :: DecoderInitStatus
minBound :: DecoderInitStatus
$cminBound :: DecoderInitStatus
Bounded, Int -> DecoderInitStatus
DecoderInitStatus -> Int
DecoderInitStatus -> [DecoderInitStatus]
DecoderInitStatus -> DecoderInitStatus
DecoderInitStatus -> DecoderInitStatus -> [DecoderInitStatus]
DecoderInitStatus
-> DecoderInitStatus -> DecoderInitStatus -> [DecoderInitStatus]
(DecoderInitStatus -> DecoderInitStatus)
-> (DecoderInitStatus -> DecoderInitStatus)
-> (Int -> DecoderInitStatus)
-> (DecoderInitStatus -> Int)
-> (DecoderInitStatus -> [DecoderInitStatus])
-> (DecoderInitStatus -> DecoderInitStatus -> [DecoderInitStatus])
-> (DecoderInitStatus -> DecoderInitStatus -> [DecoderInitStatus])
-> (DecoderInitStatus
    -> DecoderInitStatus -> DecoderInitStatus -> [DecoderInitStatus])
-> Enum DecoderInitStatus
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 :: DecoderInitStatus
-> DecoderInitStatus -> DecoderInitStatus -> [DecoderInitStatus]
$cenumFromThenTo :: DecoderInitStatus
-> DecoderInitStatus -> DecoderInitStatus -> [DecoderInitStatus]
enumFromTo :: DecoderInitStatus -> DecoderInitStatus -> [DecoderInitStatus]
$cenumFromTo :: DecoderInitStatus -> DecoderInitStatus -> [DecoderInitStatus]
enumFromThen :: DecoderInitStatus -> DecoderInitStatus -> [DecoderInitStatus]
$cenumFromThen :: DecoderInitStatus -> DecoderInitStatus -> [DecoderInitStatus]
enumFrom :: DecoderInitStatus -> [DecoderInitStatus]
$cenumFrom :: DecoderInitStatus -> [DecoderInitStatus]
fromEnum :: DecoderInitStatus -> Int
$cfromEnum :: DecoderInitStatus -> Int
toEnum :: Int -> DecoderInitStatus
$ctoEnum :: Int -> DecoderInitStatus
pred :: DecoderInitStatus -> DecoderInitStatus
$cpred :: DecoderInitStatus -> DecoderInitStatus
succ :: DecoderInitStatus -> DecoderInitStatus
$csucc :: DecoderInitStatus -> DecoderInitStatus
Enum)

-- | Enumeration of decoder states.
data DecoderState
  = -- | The decoder is ready to search for metadata.
    DecoderStateSearchForMetadata
  | -- | The decoder is ready to or is in the process of reading metadata.
    DecoderStateReadMetadata
  | -- | The decoder is ready to or is in the process of searching for the
    -- frame sync code.
    DecoderStateSearchForFrameSync
  | -- | The decoder is ready to or is in the process of reading a frame.
    DecoderStateReadFrame
  | -- | The decoder has reached the end of the stream.
    DecoderStateEndOfStream
  | -- | An error occurred in the underlying Ogg layer.
    DecoderStateOggError
  | -- | An error occurred while seeking. The decoder must be flushed or
    -- reset before decoding can continue.
    DecoderStateSeekError
  | -- | The decoder was aborted by the read callback.
    DecoderStateAborted
  | -- | An error occurred allocating memory. The decoder is in an invalid
    -- state and can no longer be used.
    DecoderStateMemoryAllocationError
  | -- | The decoder is in the uninitialized state.
    DecoderStateUnititialized
  deriving (Int -> DecoderState -> ShowS
[DecoderState] -> ShowS
DecoderState -> String
(Int -> DecoderState -> ShowS)
-> (DecoderState -> String)
-> ([DecoderState] -> ShowS)
-> Show DecoderState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecoderState] -> ShowS
$cshowList :: [DecoderState] -> ShowS
show :: DecoderState -> String
$cshow :: DecoderState -> String
showsPrec :: Int -> DecoderState -> ShowS
$cshowsPrec :: Int -> DecoderState -> ShowS
Show, ReadPrec [DecoderState]
ReadPrec DecoderState
Int -> ReadS DecoderState
ReadS [DecoderState]
(Int -> ReadS DecoderState)
-> ReadS [DecoderState]
-> ReadPrec DecoderState
-> ReadPrec [DecoderState]
-> Read DecoderState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DecoderState]
$creadListPrec :: ReadPrec [DecoderState]
readPrec :: ReadPrec DecoderState
$creadPrec :: ReadPrec DecoderState
readList :: ReadS [DecoderState]
$creadList :: ReadS [DecoderState]
readsPrec :: Int -> ReadS DecoderState
$creadsPrec :: Int -> ReadS DecoderState
Read, DecoderState -> DecoderState -> Bool
(DecoderState -> DecoderState -> Bool)
-> (DecoderState -> DecoderState -> Bool) -> Eq DecoderState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecoderState -> DecoderState -> Bool
$c/= :: DecoderState -> DecoderState -> Bool
== :: DecoderState -> DecoderState -> Bool
$c== :: DecoderState -> DecoderState -> Bool
Eq, Eq DecoderState
Eq DecoderState =>
(DecoderState -> DecoderState -> Ordering)
-> (DecoderState -> DecoderState -> Bool)
-> (DecoderState -> DecoderState -> Bool)
-> (DecoderState -> DecoderState -> Bool)
-> (DecoderState -> DecoderState -> Bool)
-> (DecoderState -> DecoderState -> DecoderState)
-> (DecoderState -> DecoderState -> DecoderState)
-> Ord DecoderState
DecoderState -> DecoderState -> Bool
DecoderState -> DecoderState -> Ordering
DecoderState -> DecoderState -> DecoderState
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 :: DecoderState -> DecoderState -> DecoderState
$cmin :: DecoderState -> DecoderState -> DecoderState
max :: DecoderState -> DecoderState -> DecoderState
$cmax :: DecoderState -> DecoderState -> DecoderState
>= :: DecoderState -> DecoderState -> Bool
$c>= :: DecoderState -> DecoderState -> Bool
> :: DecoderState -> DecoderState -> Bool
$c> :: DecoderState -> DecoderState -> Bool
<= :: DecoderState -> DecoderState -> Bool
$c<= :: DecoderState -> DecoderState -> Bool
< :: DecoderState -> DecoderState -> Bool
$c< :: DecoderState -> DecoderState -> Bool
compare :: DecoderState -> DecoderState -> Ordering
$ccompare :: DecoderState -> DecoderState -> Ordering
$cp1Ord :: Eq DecoderState
Ord, DecoderState
DecoderState -> DecoderState -> Bounded DecoderState
forall a. a -> a -> Bounded a
maxBound :: DecoderState
$cmaxBound :: DecoderState
minBound :: DecoderState
$cminBound :: DecoderState
Bounded, Int -> DecoderState
DecoderState -> Int
DecoderState -> [DecoderState]
DecoderState -> DecoderState
DecoderState -> DecoderState -> [DecoderState]
DecoderState -> DecoderState -> DecoderState -> [DecoderState]
(DecoderState -> DecoderState)
-> (DecoderState -> DecoderState)
-> (Int -> DecoderState)
-> (DecoderState -> Int)
-> (DecoderState -> [DecoderState])
-> (DecoderState -> DecoderState -> [DecoderState])
-> (DecoderState -> DecoderState -> [DecoderState])
-> (DecoderState -> DecoderState -> DecoderState -> [DecoderState])
-> Enum DecoderState
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 :: DecoderState -> DecoderState -> DecoderState -> [DecoderState]
$cenumFromThenTo :: DecoderState -> DecoderState -> DecoderState -> [DecoderState]
enumFromTo :: DecoderState -> DecoderState -> [DecoderState]
$cenumFromTo :: DecoderState -> DecoderState -> [DecoderState]
enumFromThen :: DecoderState -> DecoderState -> [DecoderState]
$cenumFromThen :: DecoderState -> DecoderState -> [DecoderState]
enumFrom :: DecoderState -> [DecoderState]
$cenumFrom :: DecoderState -> [DecoderState]
fromEnum :: DecoderState -> Int
$cfromEnum :: DecoderState -> Int
toEnum :: Int -> DecoderState
$ctoEnum :: Int -> DecoderState
pred :: DecoderState -> DecoderState
$cpred :: DecoderState -> DecoderState
succ :: DecoderState -> DecoderState
$csucc :: DecoderState -> DecoderState
Enum)

-- | Exception that is thrown when decoding fails for some reason.
data DecoderException
  = -- | Decoder initialization failed.
    DecoderInitFailed DecoderInitStatus
  | -- | Decoder failed.
    DecoderFailed DecoderState
  deriving (DecoderException -> DecoderException -> Bool
(DecoderException -> DecoderException -> Bool)
-> (DecoderException -> DecoderException -> Bool)
-> Eq DecoderException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecoderException -> DecoderException -> Bool
$c/= :: DecoderException -> DecoderException -> Bool
== :: DecoderException -> DecoderException -> Bool
$c== :: DecoderException -> DecoderException -> Bool
Eq, Int -> DecoderException -> ShowS
[DecoderException] -> ShowS
DecoderException -> String
(Int -> DecoderException -> ShowS)
-> (DecoderException -> String)
-> ([DecoderException] -> ShowS)
-> Show DecoderException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecoderException] -> ShowS
$cshowList :: [DecoderException] -> ShowS
show :: DecoderException -> String
$cshow :: DecoderException -> String
showsPrec :: Int -> DecoderException -> ShowS
$cshowsPrec :: Int -> DecoderException -> ShowS
Show, ReadPrec [DecoderException]
ReadPrec DecoderException
Int -> ReadS DecoderException
ReadS [DecoderException]
(Int -> ReadS DecoderException)
-> ReadS [DecoderException]
-> ReadPrec DecoderException
-> ReadPrec [DecoderException]
-> Read DecoderException
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DecoderException]
$creadListPrec :: ReadPrec [DecoderException]
readPrec :: ReadPrec DecoderException
$creadPrec :: ReadPrec DecoderException
readList :: ReadS [DecoderException]
$creadList :: ReadS [DecoderException]
readsPrec :: Int -> ReadS DecoderException
$creadsPrec :: Int -> ReadS DecoderException
Read)

instance Exception DecoderException

-- | An enumeration of the available channel assignments.
data ChannelAssignment
  = -- | Independent channels
    ChannelAssignmentIndependent
  | -- | Left+side stereo
    ChannelAssignmentLeftSide
  | -- | Right+side stereo
    ChannelAssignmentRightSide
  | -- | Mid+side stereo
    ChannelAssignmentMidSide
  deriving (Int -> ChannelAssignment -> ShowS
[ChannelAssignment] -> ShowS
ChannelAssignment -> String
(Int -> ChannelAssignment -> ShowS)
-> (ChannelAssignment -> String)
-> ([ChannelAssignment] -> ShowS)
-> Show ChannelAssignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelAssignment] -> ShowS
$cshowList :: [ChannelAssignment] -> ShowS
show :: ChannelAssignment -> String
$cshow :: ChannelAssignment -> String
showsPrec :: Int -> ChannelAssignment -> ShowS
$cshowsPrec :: Int -> ChannelAssignment -> ShowS
Show, ReadPrec [ChannelAssignment]
ReadPrec ChannelAssignment
Int -> ReadS ChannelAssignment
ReadS [ChannelAssignment]
(Int -> ReadS ChannelAssignment)
-> ReadS [ChannelAssignment]
-> ReadPrec ChannelAssignment
-> ReadPrec [ChannelAssignment]
-> Read ChannelAssignment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChannelAssignment]
$creadListPrec :: ReadPrec [ChannelAssignment]
readPrec :: ReadPrec ChannelAssignment
$creadPrec :: ReadPrec ChannelAssignment
readList :: ReadS [ChannelAssignment]
$creadList :: ReadS [ChannelAssignment]
readsPrec :: Int -> ReadS ChannelAssignment
$creadsPrec :: Int -> ReadS ChannelAssignment
Read, ChannelAssignment -> ChannelAssignment -> Bool
(ChannelAssignment -> ChannelAssignment -> Bool)
-> (ChannelAssignment -> ChannelAssignment -> Bool)
-> Eq ChannelAssignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelAssignment -> ChannelAssignment -> Bool
$c/= :: ChannelAssignment -> ChannelAssignment -> Bool
== :: ChannelAssignment -> ChannelAssignment -> Bool
$c== :: ChannelAssignment -> ChannelAssignment -> Bool
Eq, Eq ChannelAssignment
Eq ChannelAssignment =>
(ChannelAssignment -> ChannelAssignment -> Ordering)
-> (ChannelAssignment -> ChannelAssignment -> Bool)
-> (ChannelAssignment -> ChannelAssignment -> Bool)
-> (ChannelAssignment -> ChannelAssignment -> Bool)
-> (ChannelAssignment -> ChannelAssignment -> Bool)
-> (ChannelAssignment -> ChannelAssignment -> ChannelAssignment)
-> (ChannelAssignment -> ChannelAssignment -> ChannelAssignment)
-> Ord ChannelAssignment
ChannelAssignment -> ChannelAssignment -> Bool
ChannelAssignment -> ChannelAssignment -> Ordering
ChannelAssignment -> ChannelAssignment -> ChannelAssignment
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 :: ChannelAssignment -> ChannelAssignment -> ChannelAssignment
$cmin :: ChannelAssignment -> ChannelAssignment -> ChannelAssignment
max :: ChannelAssignment -> ChannelAssignment -> ChannelAssignment
$cmax :: ChannelAssignment -> ChannelAssignment -> ChannelAssignment
>= :: ChannelAssignment -> ChannelAssignment -> Bool
$c>= :: ChannelAssignment -> ChannelAssignment -> Bool
> :: ChannelAssignment -> ChannelAssignment -> Bool
$c> :: ChannelAssignment -> ChannelAssignment -> Bool
<= :: ChannelAssignment -> ChannelAssignment -> Bool
$c<= :: ChannelAssignment -> ChannelAssignment -> Bool
< :: ChannelAssignment -> ChannelAssignment -> Bool
$c< :: ChannelAssignment -> ChannelAssignment -> Bool
compare :: ChannelAssignment -> ChannelAssignment -> Ordering
$ccompare :: ChannelAssignment -> ChannelAssignment -> Ordering
$cp1Ord :: Eq ChannelAssignment
Ord, ChannelAssignment
ChannelAssignment -> ChannelAssignment -> Bounded ChannelAssignment
forall a. a -> a -> Bounded a
maxBound :: ChannelAssignment
$cmaxBound :: ChannelAssignment
minBound :: ChannelAssignment
$cminBound :: ChannelAssignment
Bounded, Int -> ChannelAssignment
ChannelAssignment -> Int
ChannelAssignment -> [ChannelAssignment]
ChannelAssignment -> ChannelAssignment
ChannelAssignment -> ChannelAssignment -> [ChannelAssignment]
ChannelAssignment
-> ChannelAssignment -> ChannelAssignment -> [ChannelAssignment]
(ChannelAssignment -> ChannelAssignment)
-> (ChannelAssignment -> ChannelAssignment)
-> (Int -> ChannelAssignment)
-> (ChannelAssignment -> Int)
-> (ChannelAssignment -> [ChannelAssignment])
-> (ChannelAssignment -> ChannelAssignment -> [ChannelAssignment])
-> (ChannelAssignment -> ChannelAssignment -> [ChannelAssignment])
-> (ChannelAssignment
    -> ChannelAssignment -> ChannelAssignment -> [ChannelAssignment])
-> Enum ChannelAssignment
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 :: ChannelAssignment
-> ChannelAssignment -> ChannelAssignment -> [ChannelAssignment]
$cenumFromThenTo :: ChannelAssignment
-> ChannelAssignment -> ChannelAssignment -> [ChannelAssignment]
enumFromTo :: ChannelAssignment -> ChannelAssignment -> [ChannelAssignment]
$cenumFromTo :: ChannelAssignment -> ChannelAssignment -> [ChannelAssignment]
enumFromThen :: ChannelAssignment -> ChannelAssignment -> [ChannelAssignment]
$cenumFromThen :: ChannelAssignment -> ChannelAssignment -> [ChannelAssignment]
enumFrom :: ChannelAssignment -> [ChannelAssignment]
$cenumFrom :: ChannelAssignment -> [ChannelAssignment]
fromEnum :: ChannelAssignment -> Int
$cfromEnum :: ChannelAssignment -> Int
toEnum :: Int -> ChannelAssignment
$ctoEnum :: Int -> ChannelAssignment
pred :: ChannelAssignment -> ChannelAssignment
$cpred :: ChannelAssignment -> ChannelAssignment
succ :: ChannelAssignment -> ChannelAssignment
$csucc :: ChannelAssignment -> ChannelAssignment
Enum)