{-# Language CPP #-}
-- | Csound's command line flags. See original documentation for detailed overview: <http://www.csounds.com/manual/html/CommandFlagsCategory.html>
module Csound.Dynamic.Types.Flags(
    Flags(..),

    -- * Audio file output
    AudioFileOutput(..),
    FormatHeader(..), FormatSamples(..), FormatType(..),
    Dither(..), IdTags(..),

    -- * Realtime Audio Input/Output
    Rtaudio(..), PulseAudio(..),

    -- * MIDI File Input/Ouput
    MidiIO(..),

    -- * MIDI Realtime Input/Ouput
    MidiRT(..), Rtmidi(..),

    -- * Display
    Displays(..), DisplayMode(..),

    -- * Performance Configuration and Control
    Config(..)
) where

import Control.Applicative

import Data.Char
import Data.Default
import Data.Maybe
import Data.Monoid

import Text.PrettyPrint.Leijen

mappendBool :: Bool -> Bool -> Bool
mappendBool :: Bool -> Bool -> Bool
mappendBool Bool
a Bool
b = Any -> Bool
getAny (Any -> Bool) -> Any -> Bool
forall a b. (a -> b) -> a -> b
$ Any -> Any -> Any
forall a. Monoid a => a -> a -> a
mappend (Bool -> Any
Any Bool
a) (Bool -> Any
Any Bool
b)

data Flags = Flags
    { Flags -> AudioFileOutput
audioFileOutput   :: AudioFileOutput
    , Flags -> IdTags
idTags            :: IdTags
    , Flags -> Maybe Rtaudio
rtaudio           :: Maybe Rtaudio
    , Flags -> Maybe PulseAudio
pulseAudio        :: Maybe PulseAudio
    , Flags -> MidiIO
midiIO            :: MidiIO
    , Flags -> MidiRT
midiRT            :: MidiRT
    , Flags -> Maybe Rtmidi
rtmidi            :: Maybe Rtmidi
    , Flags -> Displays
displays          :: Displays
    , Flags -> Config
config            :: Config
    , Flags -> Maybe String
flagsVerbatim     :: Maybe String
    } deriving (Flags -> Flags -> Bool
(Flags -> Flags -> Bool) -> (Flags -> Flags -> Bool) -> Eq Flags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flags -> Flags -> Bool
$c/= :: Flags -> Flags -> Bool
== :: Flags -> Flags -> Bool
$c== :: Flags -> Flags -> Bool
Eq, Int -> Flags -> ShowS
[Flags] -> ShowS
Flags -> String
(Int -> Flags -> ShowS)
-> (Flags -> String) -> ([Flags] -> ShowS) -> Show Flags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flags] -> ShowS
$cshowList :: [Flags] -> ShowS
show :: Flags -> String
$cshow :: Flags -> String
showsPrec :: Int -> Flags -> ShowS
$cshowsPrec :: Int -> Flags -> ShowS
Show, ReadPrec [Flags]
ReadPrec Flags
Int -> ReadS Flags
ReadS [Flags]
(Int -> ReadS Flags)
-> ReadS [Flags]
-> ReadPrec Flags
-> ReadPrec [Flags]
-> Read Flags
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Flags]
$creadListPrec :: ReadPrec [Flags]
readPrec :: ReadPrec Flags
$creadPrec :: ReadPrec Flags
readList :: ReadS [Flags]
$creadList :: ReadS [Flags]
readsPrec :: Int -> ReadS Flags
$creadsPrec :: Int -> ReadS Flags
Read)

instance Default Flags where
    def :: Flags
def = AudioFileOutput
-> IdTags
-> Maybe Rtaudio
-> Maybe PulseAudio
-> MidiIO
-> MidiRT
-> Maybe Rtmidi
-> Displays
-> Config
-> Maybe String
-> Flags
Flags AudioFileOutput
forall a. Default a => a
def IdTags
forall a. Default a => a
def Maybe Rtaudio
forall a. Default a => a
def Maybe PulseAudio
forall a. Default a => a
def MidiIO
forall a. Default a => a
def MidiRT
forall a. Default a => a
def Maybe Rtmidi
forall a. Default a => a
def Displays
forall a. Default a => a
def Config
forall a. Default a => a
def Maybe String
forall a. Default a => a
def


#if MIN_VERSION_base(4,11,0)
instance Semigroup Flags where
  Flags
x <> :: Flags -> Flags -> Flags
<> Flags
y          = Flags
x Flags -> Flags -> Flags
`mappendFlags` Flags
y

instance Monoid Flags where
    mempty :: Flags
mempty  = Flags
forall a. Default a => a
def

#else

instance Monoid Flags where
    mempty  = def
    mappend = mappendFlags

#endif

mappendFlags :: Flags -> Flags -> Flags
mappendFlags :: Flags -> Flags -> Flags
mappendFlags Flags
a Flags
b = Flags :: AudioFileOutput
-> IdTags
-> Maybe Rtaudio
-> Maybe PulseAudio
-> MidiIO
-> MidiRT
-> Maybe Rtmidi
-> Displays
-> Config
-> Maybe String
-> Flags
Flags
    { audioFileOutput :: AudioFileOutput
audioFileOutput   = AudioFileOutput -> AudioFileOutput -> AudioFileOutput
forall a. Monoid a => a -> a -> a
mappend (Flags -> AudioFileOutput
audioFileOutput Flags
a) (Flags -> AudioFileOutput
audioFileOutput Flags
b)
    , idTags :: IdTags
idTags            = IdTags -> IdTags -> IdTags
forall a. Monoid a => a -> a -> a
mappend (Flags -> IdTags
idTags Flags
a) (Flags -> IdTags
idTags Flags
b)
    , rtaudio :: Maybe Rtaudio
rtaudio           = Flags -> Maybe Rtaudio
rtaudio Flags
a Maybe Rtaudio -> Maybe Rtaudio -> Maybe Rtaudio
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Flags -> Maybe Rtaudio
rtaudio Flags
b
    , pulseAudio :: Maybe PulseAudio
pulseAudio        = Flags -> Maybe PulseAudio
pulseAudio Flags
a Maybe PulseAudio -> Maybe PulseAudio -> Maybe PulseAudio
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Flags -> Maybe PulseAudio
pulseAudio Flags
b
    , midiIO :: MidiIO
midiIO            = MidiIO -> MidiIO -> MidiIO
forall a. Monoid a => a -> a -> a
mappend (Flags -> MidiIO
midiIO Flags
a) (Flags -> MidiIO
midiIO Flags
b)
    , midiRT :: MidiRT
midiRT            = MidiRT -> MidiRT -> MidiRT
forall a. Monoid a => a -> a -> a
mappend (Flags -> MidiRT
midiRT Flags
a) (Flags -> MidiRT
midiRT Flags
b)
    , rtmidi :: Maybe Rtmidi
rtmidi            = Flags -> Maybe Rtmidi
rtmidi Flags
a Maybe Rtmidi -> Maybe Rtmidi -> Maybe Rtmidi
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Flags -> Maybe Rtmidi
rtmidi Flags
b
    , displays :: Displays
displays          = Displays -> Displays -> Displays
forall a. Monoid a => a -> a -> a
mappend (Flags -> Displays
displays Flags
a) (Flags -> Displays
displays Flags
b)
    , config :: Config
config            = Config -> Config -> Config
forall a. Monoid a => a -> a -> a
mappend (Flags -> Config
config Flags
a) (Flags -> Config
config Flags
b)
    , flagsVerbatim :: Maybe String
flagsVerbatim     = Maybe String -> Maybe String -> Maybe String
forall a. Monoid a => a -> a -> a
mappend (Flags -> Maybe String
flagsVerbatim Flags
a) (Flags -> Maybe String
flagsVerbatim Flags
b)
    }


-- Audio file output

data AudioFileOutput = AudioFileOutput
    { AudioFileOutput -> Maybe FormatSamples
formatSamples     :: Maybe FormatSamples
    , AudioFileOutput -> Maybe FormatType
formatType        :: Maybe FormatType
    , AudioFileOutput -> Maybe String
output            :: Maybe String
    , AudioFileOutput -> Maybe String
input             :: Maybe String
    , AudioFileOutput -> Bool
nosound           :: Bool
    , AudioFileOutput -> Bool
nopeaks           :: Bool
    , AudioFileOutput -> Maybe Dither
dither            :: Maybe Dither
    } deriving (AudioFileOutput -> AudioFileOutput -> Bool
(AudioFileOutput -> AudioFileOutput -> Bool)
-> (AudioFileOutput -> AudioFileOutput -> Bool)
-> Eq AudioFileOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AudioFileOutput -> AudioFileOutput -> Bool
$c/= :: AudioFileOutput -> AudioFileOutput -> Bool
== :: AudioFileOutput -> AudioFileOutput -> Bool
$c== :: AudioFileOutput -> AudioFileOutput -> Bool
Eq, Int -> AudioFileOutput -> ShowS
[AudioFileOutput] -> ShowS
AudioFileOutput -> String
(Int -> AudioFileOutput -> ShowS)
-> (AudioFileOutput -> String)
-> ([AudioFileOutput] -> ShowS)
-> Show AudioFileOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AudioFileOutput] -> ShowS
$cshowList :: [AudioFileOutput] -> ShowS
show :: AudioFileOutput -> String
$cshow :: AudioFileOutput -> String
showsPrec :: Int -> AudioFileOutput -> ShowS
$cshowsPrec :: Int -> AudioFileOutput -> ShowS
Show, ReadPrec [AudioFileOutput]
ReadPrec AudioFileOutput
Int -> ReadS AudioFileOutput
ReadS [AudioFileOutput]
(Int -> ReadS AudioFileOutput)
-> ReadS [AudioFileOutput]
-> ReadPrec AudioFileOutput
-> ReadPrec [AudioFileOutput]
-> Read AudioFileOutput
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AudioFileOutput]
$creadListPrec :: ReadPrec [AudioFileOutput]
readPrec :: ReadPrec AudioFileOutput
$creadPrec :: ReadPrec AudioFileOutput
readList :: ReadS [AudioFileOutput]
$creadList :: ReadS [AudioFileOutput]
readsPrec :: Int -> ReadS AudioFileOutput
$creadsPrec :: Int -> ReadS AudioFileOutput
Read)

instance Default AudioFileOutput where
    def :: AudioFileOutput
def = Maybe FormatSamples
-> Maybe FormatType
-> Maybe String
-> Maybe String
-> Bool
-> Bool
-> Maybe Dither
-> AudioFileOutput
AudioFileOutput Maybe FormatSamples
forall a. Default a => a
def Maybe FormatType
forall a. Default a => a
def Maybe String
forall a. Default a => a
def Maybe String
forall a. Default a => a
def Bool
False Bool
False Maybe Dither
forall a. Default a => a
def

#if MIN_VERSION_base(4,11,0)
instance Semigroup AudioFileOutput where
  AudioFileOutput
x <> :: AudioFileOutput -> AudioFileOutput -> AudioFileOutput
<> AudioFileOutput
y          = AudioFileOutput
x AudioFileOutput -> AudioFileOutput -> AudioFileOutput
`mappendAudioFileOutput` AudioFileOutput
y

instance Monoid AudioFileOutput where
    mempty :: AudioFileOutput
mempty  = AudioFileOutput
forall a. Default a => a
def

#else

instance Monoid AudioFileOutput where
    mempty  = def
    mappend = mappendAudioFileOutput

#endif

mappendAudioFileOutput :: AudioFileOutput -> AudioFileOutput -> AudioFileOutput
mappendAudioFileOutput :: AudioFileOutput -> AudioFileOutput -> AudioFileOutput
mappendAudioFileOutput AudioFileOutput
a AudioFileOutput
b = AudioFileOutput :: Maybe FormatSamples
-> Maybe FormatType
-> Maybe String
-> Maybe String
-> Bool
-> Bool
-> Maybe Dither
-> AudioFileOutput
AudioFileOutput
    { formatSamples :: Maybe FormatSamples
formatSamples     = AudioFileOutput -> Maybe FormatSamples
formatSamples AudioFileOutput
a Maybe FormatSamples -> Maybe FormatSamples -> Maybe FormatSamples
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AudioFileOutput -> Maybe FormatSamples
formatSamples AudioFileOutput
b
    , formatType :: Maybe FormatType
formatType        = AudioFileOutput -> Maybe FormatType
formatType AudioFileOutput
a Maybe FormatType -> Maybe FormatType -> Maybe FormatType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AudioFileOutput -> Maybe FormatType
formatType AudioFileOutput
b
    , output :: Maybe String
output            = AudioFileOutput -> Maybe String
output AudioFileOutput
a Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AudioFileOutput -> Maybe String
output AudioFileOutput
b
    , input :: Maybe String
input             = AudioFileOutput -> Maybe String
input AudioFileOutput
a Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AudioFileOutput -> Maybe String
input AudioFileOutput
b
    , nosound :: Bool
nosound           = Bool -> Bool -> Bool
mappendBool (AudioFileOutput -> Bool
nosound AudioFileOutput
a) (AudioFileOutput -> Bool
nosound AudioFileOutput
b)
    , nopeaks :: Bool
nopeaks           = Bool -> Bool -> Bool
mappendBool (AudioFileOutput -> Bool
nopeaks AudioFileOutput
a) (AudioFileOutput -> Bool
nopeaks AudioFileOutput
b)
    , dither :: Maybe Dither
dither            = AudioFileOutput -> Maybe Dither
dither AudioFileOutput
a Maybe Dither -> Maybe Dither -> Maybe Dither
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AudioFileOutput -> Maybe Dither
dither AudioFileOutput
b }

data FormatHeader = NoHeader | RewriteHeader
    deriving (FormatHeader -> FormatHeader -> Bool
(FormatHeader -> FormatHeader -> Bool)
-> (FormatHeader -> FormatHeader -> Bool) -> Eq FormatHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatHeader -> FormatHeader -> Bool
$c/= :: FormatHeader -> FormatHeader -> Bool
== :: FormatHeader -> FormatHeader -> Bool
$c== :: FormatHeader -> FormatHeader -> Bool
Eq, Int -> FormatHeader -> ShowS
[FormatHeader] -> ShowS
FormatHeader -> String
(Int -> FormatHeader -> ShowS)
-> (FormatHeader -> String)
-> ([FormatHeader] -> ShowS)
-> Show FormatHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatHeader] -> ShowS
$cshowList :: [FormatHeader] -> ShowS
show :: FormatHeader -> String
$cshow :: FormatHeader -> String
showsPrec :: Int -> FormatHeader -> ShowS
$cshowsPrec :: Int -> FormatHeader -> ShowS
Show, ReadPrec [FormatHeader]
ReadPrec FormatHeader
Int -> ReadS FormatHeader
ReadS [FormatHeader]
(Int -> ReadS FormatHeader)
-> ReadS [FormatHeader]
-> ReadPrec FormatHeader
-> ReadPrec [FormatHeader]
-> Read FormatHeader
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FormatHeader]
$creadListPrec :: ReadPrec [FormatHeader]
readPrec :: ReadPrec FormatHeader
$creadPrec :: ReadPrec FormatHeader
readList :: ReadS [FormatHeader]
$creadList :: ReadS [FormatHeader]
readsPrec :: Int -> ReadS FormatHeader
$creadsPrec :: Int -> ReadS FormatHeader
Read)

data FormatSamples
    = Bit24 | Alaw | Uchar | Schar
    | FloatSamples | Ulaw | Short | Long
    deriving (FormatSamples -> FormatSamples -> Bool
(FormatSamples -> FormatSamples -> Bool)
-> (FormatSamples -> FormatSamples -> Bool) -> Eq FormatSamples
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatSamples -> FormatSamples -> Bool
$c/= :: FormatSamples -> FormatSamples -> Bool
== :: FormatSamples -> FormatSamples -> Bool
$c== :: FormatSamples -> FormatSamples -> Bool
Eq, Int -> FormatSamples -> ShowS
[FormatSamples] -> ShowS
FormatSamples -> String
(Int -> FormatSamples -> ShowS)
-> (FormatSamples -> String)
-> ([FormatSamples] -> ShowS)
-> Show FormatSamples
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatSamples] -> ShowS
$cshowList :: [FormatSamples] -> ShowS
show :: FormatSamples -> String
$cshow :: FormatSamples -> String
showsPrec :: Int -> FormatSamples -> ShowS
$cshowsPrec :: Int -> FormatSamples -> ShowS
Show, ReadPrec [FormatSamples]
ReadPrec FormatSamples
Int -> ReadS FormatSamples
ReadS [FormatSamples]
(Int -> ReadS FormatSamples)
-> ReadS [FormatSamples]
-> ReadPrec FormatSamples
-> ReadPrec [FormatSamples]
-> Read FormatSamples
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FormatSamples]
$creadListPrec :: ReadPrec [FormatSamples]
readPrec :: ReadPrec FormatSamples
$creadPrec :: ReadPrec FormatSamples
readList :: ReadS [FormatSamples]
$creadList :: ReadS [FormatSamples]
readsPrec :: Int -> ReadS FormatSamples
$creadsPrec :: Int -> ReadS FormatSamples
Read)

data Dither = Triangular | Uniform
    deriving (Dither -> Dither -> Bool
(Dither -> Dither -> Bool)
-> (Dither -> Dither -> Bool) -> Eq Dither
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dither -> Dither -> Bool
$c/= :: Dither -> Dither -> Bool
== :: Dither -> Dither -> Bool
$c== :: Dither -> Dither -> Bool
Eq, Int -> Dither -> ShowS
[Dither] -> ShowS
Dither -> String
(Int -> Dither -> ShowS)
-> (Dither -> String) -> ([Dither] -> ShowS) -> Show Dither
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dither] -> ShowS
$cshowList :: [Dither] -> ShowS
show :: Dither -> String
$cshow :: Dither -> String
showsPrec :: Int -> Dither -> ShowS
$cshowsPrec :: Int -> Dither -> ShowS
Show, ReadPrec [Dither]
ReadPrec Dither
Int -> ReadS Dither
ReadS [Dither]
(Int -> ReadS Dither)
-> ReadS [Dither]
-> ReadPrec Dither
-> ReadPrec [Dither]
-> Read Dither
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Dither]
$creadListPrec :: ReadPrec [Dither]
readPrec :: ReadPrec Dither
$creadPrec :: ReadPrec Dither
readList :: ReadS [Dither]
$creadList :: ReadS [Dither]
readsPrec :: Int -> ReadS Dither
$creadsPrec :: Int -> ReadS Dither
Read)

data FormatType
    = Aiff | Au | Avr | Caf | Flac | Htk
    | Ircam | Mat4 | Mat5 | Nis | Paf | Pvf
    | Raw | Sd2 | Sds | Svx | Voc | W64
    | Wav | Wavex | Xi
    deriving (FormatType -> FormatType -> Bool
(FormatType -> FormatType -> Bool)
-> (FormatType -> FormatType -> Bool) -> Eq FormatType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatType -> FormatType -> Bool
$c/= :: FormatType -> FormatType -> Bool
== :: FormatType -> FormatType -> Bool
$c== :: FormatType -> FormatType -> Bool
Eq, Int -> FormatType -> ShowS
[FormatType] -> ShowS
FormatType -> String
(Int -> FormatType -> ShowS)
-> (FormatType -> String)
-> ([FormatType] -> ShowS)
-> Show FormatType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatType] -> ShowS
$cshowList :: [FormatType] -> ShowS
show :: FormatType -> String
$cshow :: FormatType -> String
showsPrec :: Int -> FormatType -> ShowS
$cshowsPrec :: Int -> FormatType -> ShowS
Show, ReadPrec [FormatType]
ReadPrec FormatType
Int -> ReadS FormatType
ReadS [FormatType]
(Int -> ReadS FormatType)
-> ReadS [FormatType]
-> ReadPrec FormatType
-> ReadPrec [FormatType]
-> Read FormatType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FormatType]
$creadListPrec :: ReadPrec [FormatType]
readPrec :: ReadPrec FormatType
$creadPrec :: ReadPrec FormatType
readList :: ReadS [FormatType]
$creadList :: ReadS [FormatType]
readsPrec :: Int -> ReadS FormatType
$creadsPrec :: Int -> ReadS FormatType
Read)

-- Output file id tags

data IdTags = IdTags
    { IdTags -> Maybe String
idArtist      :: Maybe String
    , IdTags -> Maybe String
idComment     :: Maybe String
    , IdTags -> Maybe String
idCopyright   :: Maybe String
    , IdTags -> Maybe String
idDate        :: Maybe String
    , IdTags -> Maybe String
idSoftware    :: Maybe String
    , IdTags -> Maybe String
idTitle       :: Maybe String
    } deriving (IdTags -> IdTags -> Bool
(IdTags -> IdTags -> Bool)
-> (IdTags -> IdTags -> Bool) -> Eq IdTags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdTags -> IdTags -> Bool
$c/= :: IdTags -> IdTags -> Bool
== :: IdTags -> IdTags -> Bool
$c== :: IdTags -> IdTags -> Bool
Eq, Int -> IdTags -> ShowS
[IdTags] -> ShowS
IdTags -> String
(Int -> IdTags -> ShowS)
-> (IdTags -> String) -> ([IdTags] -> ShowS) -> Show IdTags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdTags] -> ShowS
$cshowList :: [IdTags] -> ShowS
show :: IdTags -> String
$cshow :: IdTags -> String
showsPrec :: Int -> IdTags -> ShowS
$cshowsPrec :: Int -> IdTags -> ShowS
Show, ReadPrec [IdTags]
ReadPrec IdTags
Int -> ReadS IdTags
ReadS [IdTags]
(Int -> ReadS IdTags)
-> ReadS [IdTags]
-> ReadPrec IdTags
-> ReadPrec [IdTags]
-> Read IdTags
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IdTags]
$creadListPrec :: ReadPrec [IdTags]
readPrec :: ReadPrec IdTags
$creadPrec :: ReadPrec IdTags
readList :: ReadS [IdTags]
$creadList :: ReadS [IdTags]
readsPrec :: Int -> ReadS IdTags
$creadsPrec :: Int -> ReadS IdTags
Read)

instance Default IdTags where
    def :: IdTags
def = Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> IdTags
IdTags Maybe String
forall a. Default a => a
def Maybe String
forall a. Default a => a
def Maybe String
forall a. Default a => a
def Maybe String
forall a. Default a => a
def Maybe String
forall a. Default a => a
def Maybe String
forall a. Default a => a
def

#if MIN_VERSION_base(4,11,0)
instance Semigroup IdTags where
  IdTags
x <> :: IdTags -> IdTags -> IdTags
<> IdTags
y          = IdTags
x IdTags -> IdTags -> IdTags
`mappendIdTags` IdTags
y

instance Monoid IdTags where
    mempty :: IdTags
mempty  = IdTags
forall a. Default a => a
def

#else

instance Monoid IdTags where
    mempty  = def
    mappend = mappendIdTags

#endif

mappendIdTags :: IdTags -> IdTags -> IdTags
mappendIdTags :: IdTags -> IdTags -> IdTags
mappendIdTags IdTags
a IdTags
b = IdTags :: Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> IdTags
IdTags
    { idArtist :: Maybe String
idArtist      = IdTags -> Maybe String
idArtist IdTags
a Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IdTags -> Maybe String
idArtist IdTags
b
    , idComment :: Maybe String
idComment     = IdTags -> Maybe String
idComment IdTags
a Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IdTags -> Maybe String
idComment IdTags
b
    , idCopyright :: Maybe String
idCopyright   = IdTags -> Maybe String
idCopyright IdTags
a Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IdTags -> Maybe String
idCopyright IdTags
b
    , idDate :: Maybe String
idDate        = IdTags -> Maybe String
idDate IdTags
a Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IdTags -> Maybe String
idDate IdTags
b
    , idSoftware :: Maybe String
idSoftware    = IdTags -> Maybe String
idSoftware IdTags
a Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IdTags -> Maybe String
idSoftware IdTags
b
    , idTitle :: Maybe String
idTitle       = IdTags -> Maybe String
idTitle IdTags
a Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IdTags -> Maybe String
idTitle IdTags
b }

-- Realtime Audio Input/Output

data Rtaudio
    = PortAudio | Alsa
    | Jack
        { Rtaudio -> String
jackClient    :: String
        , Rtaudio -> String
jackInport    :: String
        , Rtaudio -> String
jackOutport   :: String }
    | Mme | CoreAudio
    | NoRtaudio
    deriving (Rtaudio -> Rtaudio -> Bool
(Rtaudio -> Rtaudio -> Bool)
-> (Rtaudio -> Rtaudio -> Bool) -> Eq Rtaudio
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rtaudio -> Rtaudio -> Bool
$c/= :: Rtaudio -> Rtaudio -> Bool
== :: Rtaudio -> Rtaudio -> Bool
$c== :: Rtaudio -> Rtaudio -> Bool
Eq, Int -> Rtaudio -> ShowS
[Rtaudio] -> ShowS
Rtaudio -> String
(Int -> Rtaudio -> ShowS)
-> (Rtaudio -> String) -> ([Rtaudio] -> ShowS) -> Show Rtaudio
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rtaudio] -> ShowS
$cshowList :: [Rtaudio] -> ShowS
show :: Rtaudio -> String
$cshow :: Rtaudio -> String
showsPrec :: Int -> Rtaudio -> ShowS
$cshowsPrec :: Int -> Rtaudio -> ShowS
Show, ReadPrec [Rtaudio]
ReadPrec Rtaudio
Int -> ReadS Rtaudio
ReadS [Rtaudio]
(Int -> ReadS Rtaudio)
-> ReadS [Rtaudio]
-> ReadPrec Rtaudio
-> ReadPrec [Rtaudio]
-> Read Rtaudio
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Rtaudio]
$creadListPrec :: ReadPrec [Rtaudio]
readPrec :: ReadPrec Rtaudio
$creadPrec :: ReadPrec Rtaudio
readList :: ReadS [Rtaudio]
$creadList :: ReadS [Rtaudio]
readsPrec :: Int -> ReadS Rtaudio
$creadsPrec :: Int -> ReadS Rtaudio
Read)

data PulseAudio = PulseAudio
    { PulseAudio -> String
paServer  :: String
    , PulseAudio -> String
paOutput  :: String
    , PulseAudio -> String
paInput   :: String
    } deriving (PulseAudio -> PulseAudio -> Bool
(PulseAudio -> PulseAudio -> Bool)
-> (PulseAudio -> PulseAudio -> Bool) -> Eq PulseAudio
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PulseAudio -> PulseAudio -> Bool
$c/= :: PulseAudio -> PulseAudio -> Bool
== :: PulseAudio -> PulseAudio -> Bool
$c== :: PulseAudio -> PulseAudio -> Bool
Eq, Int -> PulseAudio -> ShowS
[PulseAudio] -> ShowS
PulseAudio -> String
(Int -> PulseAudio -> ShowS)
-> (PulseAudio -> String)
-> ([PulseAudio] -> ShowS)
-> Show PulseAudio
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PulseAudio] -> ShowS
$cshowList :: [PulseAudio] -> ShowS
show :: PulseAudio -> String
$cshow :: PulseAudio -> String
showsPrec :: Int -> PulseAudio -> ShowS
$cshowsPrec :: Int -> PulseAudio -> ShowS
Show, ReadPrec [PulseAudio]
ReadPrec PulseAudio
Int -> ReadS PulseAudio
ReadS [PulseAudio]
(Int -> ReadS PulseAudio)
-> ReadS [PulseAudio]
-> ReadPrec PulseAudio
-> ReadPrec [PulseAudio]
-> Read PulseAudio
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PulseAudio]
$creadListPrec :: ReadPrec [PulseAudio]
readPrec :: ReadPrec PulseAudio
$creadPrec :: ReadPrec PulseAudio
readList :: ReadS [PulseAudio]
$creadList :: ReadS [PulseAudio]
readsPrec :: Int -> ReadS PulseAudio
$creadsPrec :: Int -> ReadS PulseAudio
Read)

-- MIDI File Input/Ouput

data MidiIO = MidiIO
    { MidiIO -> Maybe String
midiFile          :: Maybe String
    , MidiIO -> Maybe String
midiOutFile       :: Maybe String
    , MidiIO -> Maybe String
muteTracks        :: Maybe String
    , MidiIO -> Bool
rawControllerMode :: Bool
    , MidiIO -> Bool
terminateOnMidi   :: Bool
    } deriving (MidiIO -> MidiIO -> Bool
(MidiIO -> MidiIO -> Bool)
-> (MidiIO -> MidiIO -> Bool) -> Eq MidiIO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MidiIO -> MidiIO -> Bool
$c/= :: MidiIO -> MidiIO -> Bool
== :: MidiIO -> MidiIO -> Bool
$c== :: MidiIO -> MidiIO -> Bool
Eq, Int -> MidiIO -> ShowS
[MidiIO] -> ShowS
MidiIO -> String
(Int -> MidiIO -> ShowS)
-> (MidiIO -> String) -> ([MidiIO] -> ShowS) -> Show MidiIO
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MidiIO] -> ShowS
$cshowList :: [MidiIO] -> ShowS
show :: MidiIO -> String
$cshow :: MidiIO -> String
showsPrec :: Int -> MidiIO -> ShowS
$cshowsPrec :: Int -> MidiIO -> ShowS
Show, ReadPrec [MidiIO]
ReadPrec MidiIO
Int -> ReadS MidiIO
ReadS [MidiIO]
(Int -> ReadS MidiIO)
-> ReadS [MidiIO]
-> ReadPrec MidiIO
-> ReadPrec [MidiIO]
-> Read MidiIO
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MidiIO]
$creadListPrec :: ReadPrec [MidiIO]
readPrec :: ReadPrec MidiIO
$creadPrec :: ReadPrec MidiIO
readList :: ReadS [MidiIO]
$creadList :: ReadS [MidiIO]
readsPrec :: Int -> ReadS MidiIO
$creadsPrec :: Int -> ReadS MidiIO
Read)

instance Default MidiIO where
    def :: MidiIO
def = Maybe String
-> Maybe String -> Maybe String -> Bool -> Bool -> MidiIO
MidiIO Maybe String
forall a. Default a => a
def Maybe String
forall a. Default a => a
def Maybe String
forall a. Default a => a
def Bool
False Bool
False


#if MIN_VERSION_base(4,11,0)
instance Semigroup MidiIO where
  MidiIO
x <> :: MidiIO -> MidiIO -> MidiIO
<> MidiIO
y          = MidiIO
x MidiIO -> MidiIO -> MidiIO
`mappendMidiIO` MidiIO
y

instance Monoid MidiIO where
    mempty :: MidiIO
mempty  = MidiIO
forall a. Default a => a
def

#else

instance Monoid MidiIO where
    mempty  = def
    mappend = mappendMidiIO

#endif

mappendMidiIO :: MidiIO -> MidiIO -> MidiIO
mappendMidiIO :: MidiIO -> MidiIO -> MidiIO
mappendMidiIO MidiIO
a MidiIO
b = MidiIO :: Maybe String
-> Maybe String -> Maybe String -> Bool -> Bool -> MidiIO
MidiIO
    { midiFile :: Maybe String
midiFile          = MidiIO -> Maybe String
midiFile MidiIO
a Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MidiIO -> Maybe String
midiFile MidiIO
b
    , midiOutFile :: Maybe String
midiOutFile       = MidiIO -> Maybe String
midiOutFile MidiIO
a Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MidiIO -> Maybe String
midiOutFile MidiIO
b
    , muteTracks :: Maybe String
muteTracks        = MidiIO -> Maybe String
muteTracks MidiIO
a Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MidiIO -> Maybe String
muteTracks MidiIO
b
    , rawControllerMode :: Bool
rawControllerMode = Bool -> Bool -> Bool
mappendBool (MidiIO -> Bool
rawControllerMode MidiIO
a)  (MidiIO -> Bool
rawControllerMode MidiIO
b)
    , terminateOnMidi :: Bool
terminateOnMidi   = Bool -> Bool -> Bool
mappendBool (MidiIO -> Bool
terminateOnMidi MidiIO
a) (MidiIO -> Bool
terminateOnMidi MidiIO
b) }

-- MIDI Realtime Input/Ouput

data MidiRT = MidiRT
    { MidiRT -> Maybe String
midiDevice        :: Maybe String
    , MidiRT -> Maybe Int
midiKey           :: Maybe Int
    , MidiRT -> Maybe Int
midiKeyCps        :: Maybe Int
    , MidiRT -> Maybe Int
midiKeyOct        :: Maybe Int
    , MidiRT -> Maybe Int
midiKeyPch        :: Maybe Int
    , MidiRT -> Maybe Int
midiVelocity      :: Maybe Int
    , MidiRT -> Maybe Int
midiVelocityAmp   :: Maybe Int
    , MidiRT -> Maybe String
midiOutDevice     :: Maybe String
    } deriving (MidiRT -> MidiRT -> Bool
(MidiRT -> MidiRT -> Bool)
-> (MidiRT -> MidiRT -> Bool) -> Eq MidiRT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MidiRT -> MidiRT -> Bool
$c/= :: MidiRT -> MidiRT -> Bool
== :: MidiRT -> MidiRT -> Bool
$c== :: MidiRT -> MidiRT -> Bool
Eq, Int -> MidiRT -> ShowS
[MidiRT] -> ShowS
MidiRT -> String
(Int -> MidiRT -> ShowS)
-> (MidiRT -> String) -> ([MidiRT] -> ShowS) -> Show MidiRT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MidiRT] -> ShowS
$cshowList :: [MidiRT] -> ShowS
show :: MidiRT -> String
$cshow :: MidiRT -> String
showsPrec :: Int -> MidiRT -> ShowS
$cshowsPrec :: Int -> MidiRT -> ShowS
Show, ReadPrec [MidiRT]
ReadPrec MidiRT
Int -> ReadS MidiRT
ReadS [MidiRT]
(Int -> ReadS MidiRT)
-> ReadS [MidiRT]
-> ReadPrec MidiRT
-> ReadPrec [MidiRT]
-> Read MidiRT
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MidiRT]
$creadListPrec :: ReadPrec [MidiRT]
readPrec :: ReadPrec MidiRT
$creadPrec :: ReadPrec MidiRT
readList :: ReadS [MidiRT]
$creadList :: ReadS [MidiRT]
readsPrec :: Int -> ReadS MidiRT
$creadsPrec :: Int -> ReadS MidiRT
Read)

instance Default MidiRT where
    def :: MidiRT
def = Maybe String
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe String
-> MidiRT
MidiRT Maybe String
forall a. Default a => a
def Maybe Int
forall a. Default a => a
def Maybe Int
forall a. Default a => a
def Maybe Int
forall a. Default a => a
def
                 Maybe Int
forall a. Default a => a
def Maybe Int
forall a. Default a => a
def Maybe Int
forall a. Default a => a
def Maybe String
forall a. Default a => a
def

#if MIN_VERSION_base(4,11,0)
instance Semigroup MidiRT where
  MidiRT
x <> :: MidiRT -> MidiRT -> MidiRT
<> MidiRT
y          = MidiRT
x MidiRT -> MidiRT -> MidiRT
`mappendMidiRT` MidiRT
y

instance Monoid MidiRT where
    mempty :: MidiRT
mempty  = MidiRT
forall a. Default a => a
def

#else

instance Monoid MidiRT where
    mempty  = def
    mappend = mappendMidiRT

#endif

mappendMidiRT :: MidiRT -> MidiRT -> MidiRT
mappendMidiRT :: MidiRT -> MidiRT -> MidiRT
mappendMidiRT MidiRT
a MidiRT
b = MidiRT :: Maybe String
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe String
-> MidiRT
MidiRT
    { midiDevice :: Maybe String
midiDevice        = MidiRT -> Maybe String
midiDevice MidiRT
a Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MidiRT -> Maybe String
midiDevice MidiRT
b
    , midiKey :: Maybe Int
midiKey           = MidiRT -> Maybe Int
midiKey MidiRT
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MidiRT -> Maybe Int
midiKey MidiRT
b
    , midiKeyCps :: Maybe Int
midiKeyCps        = MidiRT -> Maybe Int
midiKeyCps MidiRT
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MidiRT -> Maybe Int
midiKeyCps MidiRT
b
    , midiKeyOct :: Maybe Int
midiKeyOct        = MidiRT -> Maybe Int
midiKeyOct MidiRT
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MidiRT -> Maybe Int
midiKeyOct MidiRT
b
    , midiKeyPch :: Maybe Int
midiKeyPch        = MidiRT -> Maybe Int
midiKeyPch MidiRT
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MidiRT -> Maybe Int
midiKeyPch MidiRT
b
    , midiVelocity :: Maybe Int
midiVelocity      = MidiRT -> Maybe Int
midiVelocity MidiRT
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MidiRT -> Maybe Int
midiVelocity MidiRT
b
    , midiVelocityAmp :: Maybe Int
midiVelocityAmp   = MidiRT -> Maybe Int
midiVelocityAmp MidiRT
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MidiRT -> Maybe Int
midiVelocityAmp MidiRT
b
    , midiOutDevice :: Maybe String
midiOutDevice     = MidiRT -> Maybe String
midiOutDevice MidiRT
a Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MidiRT -> Maybe String
midiOutDevice MidiRT
b }

data Rtmidi = PortMidi | AlsaMidi | AlsaSeq | CoreMidi | MmeMidi | WinmmeMidi | VirtualMidi | NoRtmidi
    deriving (Rtmidi -> Rtmidi -> Bool
(Rtmidi -> Rtmidi -> Bool)
-> (Rtmidi -> Rtmidi -> Bool) -> Eq Rtmidi
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rtmidi -> Rtmidi -> Bool
$c/= :: Rtmidi -> Rtmidi -> Bool
== :: Rtmidi -> Rtmidi -> Bool
$c== :: Rtmidi -> Rtmidi -> Bool
Eq, Int -> Rtmidi -> ShowS
[Rtmidi] -> ShowS
Rtmidi -> String
(Int -> Rtmidi -> ShowS)
-> (Rtmidi -> String) -> ([Rtmidi] -> ShowS) -> Show Rtmidi
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rtmidi] -> ShowS
$cshowList :: [Rtmidi] -> ShowS
show :: Rtmidi -> String
$cshow :: Rtmidi -> String
showsPrec :: Int -> Rtmidi -> ShowS
$cshowsPrec :: Int -> Rtmidi -> ShowS
Show, ReadPrec [Rtmidi]
ReadPrec Rtmidi
Int -> ReadS Rtmidi
ReadS [Rtmidi]
(Int -> ReadS Rtmidi)
-> ReadS [Rtmidi]
-> ReadPrec Rtmidi
-> ReadPrec [Rtmidi]
-> Read Rtmidi
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Rtmidi]
$creadListPrec :: ReadPrec [Rtmidi]
readPrec :: ReadPrec Rtmidi
$creadPrec :: ReadPrec Rtmidi
readList :: ReadS [Rtmidi]
$creadList :: ReadS [Rtmidi]
readsPrec :: Int -> ReadS Rtmidi
$creadsPrec :: Int -> ReadS Rtmidi
Read)

-- Display

data Displays = Displays
    { Displays -> Maybe Int
csdLineNums       :: Maybe Int
    , Displays -> Maybe DisplayMode
displayMode       :: Maybe DisplayMode
    , Displays -> Maybe Int
displayHeartbeat  :: Maybe Int
    , Displays -> Maybe Int
messageLevel      :: Maybe Int
    , Displays -> Maybe Int
mAmps             :: Maybe Int
    , Displays -> Maybe Int
mRange            :: Maybe Int
    , Displays -> Maybe Int
mWarnings         :: Maybe Int
    , Displays -> Maybe Int
mDb               :: Maybe Int
    , Displays -> Maybe Int
mColours          :: Maybe Int
    , Displays -> Maybe Int
mBenchmarks       :: Maybe Int
    , Displays -> Bool
msgColor          :: Bool
    , Displays -> Bool
displayVerbose    :: Bool
    , Displays -> Maybe Int
listOpcodes       :: Maybe Int
    } deriving (Displays -> Displays -> Bool
(Displays -> Displays -> Bool)
-> (Displays -> Displays -> Bool) -> Eq Displays
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Displays -> Displays -> Bool
$c/= :: Displays -> Displays -> Bool
== :: Displays -> Displays -> Bool
$c== :: Displays -> Displays -> Bool
Eq, Int -> Displays -> ShowS
[Displays] -> ShowS
Displays -> String
(Int -> Displays -> ShowS)
-> (Displays -> String) -> ([Displays] -> ShowS) -> Show Displays
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Displays] -> ShowS
$cshowList :: [Displays] -> ShowS
show :: Displays -> String
$cshow :: Displays -> String
showsPrec :: Int -> Displays -> ShowS
$cshowsPrec :: Int -> Displays -> ShowS
Show, ReadPrec [Displays]
ReadPrec Displays
Int -> ReadS Displays
ReadS [Displays]
(Int -> ReadS Displays)
-> ReadS [Displays]
-> ReadPrec Displays
-> ReadPrec [Displays]
-> Read Displays
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Displays]
$creadListPrec :: ReadPrec [Displays]
readPrec :: ReadPrec Displays
$creadPrec :: ReadPrec Displays
readList :: ReadS [Displays]
$creadList :: ReadS [Displays]
readsPrec :: Int -> ReadS Displays
$creadsPrec :: Int -> ReadS Displays
Read)

data DisplayMode = NoDisplay | PostScriptDisplay | AsciiDisplay
    deriving (DisplayMode -> DisplayMode -> Bool
(DisplayMode -> DisplayMode -> Bool)
-> (DisplayMode -> DisplayMode -> Bool) -> Eq DisplayMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayMode -> DisplayMode -> Bool
$c/= :: DisplayMode -> DisplayMode -> Bool
== :: DisplayMode -> DisplayMode -> Bool
$c== :: DisplayMode -> DisplayMode -> Bool
Eq, Int -> DisplayMode -> ShowS
[DisplayMode] -> ShowS
DisplayMode -> String
(Int -> DisplayMode -> ShowS)
-> (DisplayMode -> String)
-> ([DisplayMode] -> ShowS)
-> Show DisplayMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisplayMode] -> ShowS
$cshowList :: [DisplayMode] -> ShowS
show :: DisplayMode -> String
$cshow :: DisplayMode -> String
showsPrec :: Int -> DisplayMode -> ShowS
$cshowsPrec :: Int -> DisplayMode -> ShowS
Show, ReadPrec [DisplayMode]
ReadPrec DisplayMode
Int -> ReadS DisplayMode
ReadS [DisplayMode]
(Int -> ReadS DisplayMode)
-> ReadS [DisplayMode]
-> ReadPrec DisplayMode
-> ReadPrec [DisplayMode]
-> Read DisplayMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisplayMode]
$creadListPrec :: ReadPrec [DisplayMode]
readPrec :: ReadPrec DisplayMode
$creadPrec :: ReadPrec DisplayMode
readList :: ReadS [DisplayMode]
$creadList :: ReadS [DisplayMode]
readsPrec :: Int -> ReadS DisplayMode
$creadsPrec :: Int -> ReadS DisplayMode
Read)

instance Default Displays where
    def :: Displays
def = Maybe Int
-> Maybe DisplayMode
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Bool
-> Bool
-> Maybe Int
-> Displays
Displays Maybe Int
forall a. Default a => a
def (DisplayMode -> Maybe DisplayMode
forall a. a -> Maybe a
Just DisplayMode
NoDisplay)
            Maybe Int
forall a. Default a => a
def Maybe Int
forall a. Default a => a
def Maybe Int
forall a. Default a => a
def Maybe Int
forall a. Default a => a
def
            Maybe Int
forall a. Default a => a
def Maybe Int
forall a. Default a => a
def Maybe Int
forall a. Default a => a
def Maybe Int
forall a. Default a => a
def
            Bool
False Bool
False
            Maybe Int
forall a. Default a => a
def

#if MIN_VERSION_base(4,11,0)
instance Semigroup Displays where
  Displays
x <> :: Displays -> Displays -> Displays
<> Displays
y          = Displays
x Displays -> Displays -> Displays
`mappendDisplays` Displays
y

instance Monoid Displays where
    mempty :: Displays
mempty  = Displays
forall a. Default a => a
def

#else

instance Monoid Displays where
    mempty  = def
    mappend = mappendDisplays

#endif


mappendDisplays :: Displays -> Displays -> Displays
mappendDisplays :: Displays -> Displays -> Displays
mappendDisplays Displays
a Displays
b = Displays :: Maybe Int
-> Maybe DisplayMode
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Bool
-> Bool
-> Maybe Int
-> Displays
Displays
    { csdLineNums :: Maybe Int
csdLineNums       = Displays -> Maybe Int
csdLineNums Displays
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Displays -> Maybe Int
csdLineNums Displays
b
    , displayMode :: Maybe DisplayMode
displayMode       = Displays -> Maybe DisplayMode
displayMode Displays
a Maybe DisplayMode -> Maybe DisplayMode -> Maybe DisplayMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Displays -> Maybe DisplayMode
displayMode Displays
b
    , displayHeartbeat :: Maybe Int
displayHeartbeat  = Displays -> Maybe Int
displayHeartbeat Displays
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Displays -> Maybe Int
displayHeartbeat Displays
b
    , messageLevel :: Maybe Int
messageLevel      = Displays -> Maybe Int
messageLevel Displays
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Displays -> Maybe Int
messageLevel Displays
b
    , mAmps :: Maybe Int
mAmps             = Displays -> Maybe Int
mAmps Displays
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Displays -> Maybe Int
mAmps Displays
b
    , mRange :: Maybe Int
mRange            = Displays -> Maybe Int
mRange Displays
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Displays -> Maybe Int
mRange Displays
b
    , mWarnings :: Maybe Int
mWarnings         = Displays -> Maybe Int
mWarnings Displays
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Displays -> Maybe Int
mWarnings Displays
b
    , mDb :: Maybe Int
mDb               = Displays -> Maybe Int
mDb Displays
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Displays -> Maybe Int
mDb Displays
b
    , mColours :: Maybe Int
mColours          = Displays -> Maybe Int
mColours Displays
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Displays -> Maybe Int
mColours Displays
b
    , mBenchmarks :: Maybe Int
mBenchmarks       = Displays -> Maybe Int
mBenchmarks Displays
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Displays -> Maybe Int
mBenchmarks Displays
b
    , msgColor :: Bool
msgColor          = Bool -> Bool -> Bool
mappendBool (Displays -> Bool
msgColor Displays
a) (Displays -> Bool
msgColor Displays
b)
    , displayVerbose :: Bool
displayVerbose    = Bool -> Bool -> Bool
mappendBool (Displays -> Bool
displayVerbose Displays
a) (Displays -> Bool
displayVerbose Displays
b)
    , listOpcodes :: Maybe Int
listOpcodes       = Displays -> Maybe Int
listOpcodes Displays
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Displays -> Maybe Int
listOpcodes Displays
b }

-- Performance Configuration and Control

data Config = Config
    { Config -> Maybe Int
hwBuf         :: Maybe Int
    , Config -> Maybe Int
ioBuf         :: Maybe Int
    , Config -> Maybe Int
newKr         :: Maybe Int
    , Config -> Maybe Int
newSr         :: Maybe Int
    , Config -> Maybe String
scoreIn       :: Maybe String
    , Config -> Maybe (String, String)
omacro        :: Maybe (String, String)
    , Config -> Maybe (String, String)
smacro        :: Maybe (String, String)
    , Config -> Bool
setSched      :: Bool
    , Config -> Maybe Int
schedNum      :: Maybe Int
    , Config -> Maybe (Int, String)
strsetN       :: Maybe (Int, String)
    , Config -> Maybe Double
skipSeconds   :: Maybe Double
    , Config -> Maybe Int
setTempo      :: Maybe Int
    } deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show, ReadPrec [Config]
ReadPrec Config
Int -> ReadS Config
ReadS [Config]
(Int -> ReadS Config)
-> ReadS [Config]
-> ReadPrec Config
-> ReadPrec [Config]
-> Read Config
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Config]
$creadListPrec :: ReadPrec [Config]
readPrec :: ReadPrec Config
$creadPrec :: ReadPrec Config
readList :: ReadS [Config]
$creadList :: ReadS [Config]
readsPrec :: Int -> ReadS Config
$creadsPrec :: Int -> ReadS Config
Read)

instance Default Config where
    def :: Config
def = Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe String
-> Maybe (String, String)
-> Maybe (String, String)
-> Bool
-> Maybe Int
-> Maybe (Int, String)
-> Maybe Double
-> Maybe Int
-> Config
Config Maybe Int
forall a. Default a => a
def Maybe Int
forall a. Default a => a
def Maybe Int
forall a. Default a => a
def Maybe Int
forall a. Default a => a
def Maybe String
forall a. Default a => a
def Maybe (String, String)
forall a. Default a => a
def Maybe (String, String)
forall a. Default a => a
def
                 Bool
False
                 Maybe Int
forall a. Default a => a
def Maybe (Int, String)
forall a. Default a => a
def Maybe Double
forall a. Default a => a
def Maybe Int
forall a. Default a => a
def

#if MIN_VERSION_base(4,11,0)
instance Semigroup Config where
  Config
x <> :: Config -> Config -> Config
<> Config
y          = Config
x Config -> Config -> Config
`mappendConfig` Config
y

instance Monoid Config where
    mempty :: Config
mempty  = Config
forall a. Default a => a
def

#else

instance Monoid Config where
    mempty  = def
    mappend = mappendConfig

#endif

mappendConfig :: Config -> Config -> Config
mappendConfig :: Config -> Config -> Config
mappendConfig Config
a Config
b = Config :: Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe String
-> Maybe (String, String)
-> Maybe (String, String)
-> Bool
-> Maybe Int
-> Maybe (Int, String)
-> Maybe Double
-> Maybe Int
-> Config
Config
    { hwBuf :: Maybe Int
hwBuf     = Config -> Maybe Int
hwBuf Config
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe Int
hwBuf Config
b
    , ioBuf :: Maybe Int
ioBuf     = Config -> Maybe Int
ioBuf Config
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe Int
ioBuf Config
b
    , newKr :: Maybe Int
newKr     = Config -> Maybe Int
newKr Config
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe Int
newKr Config
b
    , newSr :: Maybe Int
newSr     = Config -> Maybe Int
newSr Config
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe Int
newSr Config
b
    , scoreIn :: Maybe String
scoreIn   = Config -> Maybe String
scoreIn Config
a Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe String
scoreIn Config
b
    , omacro :: Maybe (String, String)
omacro    = Config -> Maybe (String, String)
omacro Config
a Maybe (String, String)
-> Maybe (String, String) -> Maybe (String, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe (String, String)
omacro Config
b
    , smacro :: Maybe (String, String)
smacro    = Config -> Maybe (String, String)
smacro Config
a Maybe (String, String)
-> Maybe (String, String) -> Maybe (String, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe (String, String)
smacro Config
b
    , setSched :: Bool
setSched  = Bool -> Bool -> Bool
mappendBool (Config -> Bool
setSched Config
a) (Config -> Bool
setSched Config
b)
    , schedNum :: Maybe Int
schedNum  = Config -> Maybe Int
schedNum Config
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe Int
schedNum Config
b
    , strsetN :: Maybe (Int, String)
strsetN   = Config -> Maybe (Int, String)
strsetN Config
a Maybe (Int, String) -> Maybe (Int, String) -> Maybe (Int, String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe (Int, String)
strsetN Config
b
    , skipSeconds :: Maybe Double
skipSeconds  = Config -> Maybe Double
skipSeconds Config
a Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe Double
skipSeconds Config
b
    , setTempo :: Maybe Int
setTempo  = Config -> Maybe Int
setTempo Config
a Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe Int
setTempo Config
b }

----------------------------------------------------
-- rendering

-- just an alias for 'pretty'
p :: Pretty b => (a -> Maybe b) -> (a -> Maybe Doc)
p :: (a -> Maybe b) -> a -> Maybe Doc
p = ((b -> Doc) -> Maybe b -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Doc
forall a. Pretty a => a -> Doc
pretty (Maybe b -> Maybe Doc) -> (a -> Maybe b) -> a -> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. )

pe :: Pretty b => (a -> b) -> (a -> Maybe Doc)
pe :: (a -> b) -> a -> Maybe Doc
pe a -> b
f = b -> Maybe Doc
forall a. Pretty a => a -> Maybe Doc
phi (b -> Maybe Doc) -> (a -> b) -> a -> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
    where phi :: a -> Maybe Doc
phi a
x
            | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Doc -> String
forall a. Show a => a -> String
show Doc
res)   = Maybe Doc
forall a. Maybe a
Nothing
            | Bool
otherwise         = Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
res
            where res :: Doc
res = a -> Doc
forall a. Pretty a => a -> Doc
pretty a
x

bo :: String -> (a -> Bool) -> (a -> Maybe Doc)
bo :: String -> (a -> Bool) -> a -> Maybe Doc
bo String
property a -> Bool
extract a
a
    | a -> Bool
extract a
a = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
property
    | Bool
otherwise = Maybe Doc
forall a. Maybe a
Nothing

mp :: (String -> String) -> (a -> Maybe String) -> (a -> Maybe Doc)
mp :: ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp ShowS
f a -> Maybe String
a = (a -> Maybe String) -> a -> Maybe Doc
forall b a. Pretty b => (a -> Maybe b) -> a -> Maybe Doc
p (ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
f (Maybe String -> Maybe String)
-> (a -> Maybe String) -> a -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe String
a)

mi :: (String -> String) -> (a -> Maybe Int) -> (a -> Maybe Doc)
mi :: ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi ShowS
f a -> Maybe Int
a = ShowS -> (a -> Maybe String) -> a -> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp ShowS
f ((Int -> String) -> Maybe Int -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> String
forall a. Show a => a -> String
show (Maybe Int -> Maybe String)
-> (a -> Maybe Int) -> a -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe Int
a)

p1 :: String -> String -> String
p1 :: String -> ShowS
p1 String
pref String
x = (Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: String
pref) String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
x)

p2 :: String -> String -> String
p2 :: String -> ShowS
p2 String
pref String
x = (Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: String
pref) String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char
'=' Char -> ShowS
forall a. a -> [a] -> [a]
: String
x)

p3 :: String -> String -> String
p3 :: String -> ShowS
p3 String
pref String
x = (Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'+' Char -> ShowS
forall a. a -> [a] -> [a]
: String
pref) String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char
'=' Char -> ShowS
forall a. a -> [a] -> [a]
: String
x)

fields :: [a -> Maybe Doc] -> a -> Doc
fields :: [a -> Maybe Doc] -> a -> Doc
fields [a -> Maybe Doc]
fs a
a = [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Maybe Doc] -> [Doc]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Doc] -> [Doc]) -> [Maybe Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ((a -> Maybe Doc) -> Maybe Doc) -> [a -> Maybe Doc] -> [Maybe Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( (a -> Maybe Doc) -> a -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ a
a) [a -> Maybe Doc]
fs

instance Pretty Flags where
    pretty :: Flags -> Doc
pretty = [Flags -> Maybe Doc] -> Flags -> Doc
forall a. [a -> Maybe Doc] -> a -> Doc
fields
        [ (Flags -> Displays) -> Flags -> Maybe Doc
forall b a. Pretty b => (a -> b) -> a -> Maybe Doc
pe Flags -> Displays
displays
        , (Flags -> Config) -> Flags -> Maybe Doc
forall b a. Pretty b => (a -> b) -> a -> Maybe Doc
pe Flags -> Config
config
        , (Flags -> AudioFileOutput) -> Flags -> Maybe Doc
forall b a. Pretty b => (a -> b) -> a -> Maybe Doc
pe Flags -> AudioFileOutput
audioFileOutput
        , (Flags -> IdTags) -> Flags -> Maybe Doc
forall b a. Pretty b => (a -> b) -> a -> Maybe Doc
pe Flags -> IdTags
idTags
        , (Flags -> Maybe Rtaudio) -> Flags -> Maybe Doc
forall b a. Pretty b => (a -> Maybe b) -> a -> Maybe Doc
p  Flags -> Maybe Rtaudio
rtaudio
        , (Flags -> Maybe PulseAudio) -> Flags -> Maybe Doc
forall b a. Pretty b => (a -> Maybe b) -> a -> Maybe Doc
p  Flags -> Maybe PulseAudio
pulseAudio
        , (Flags -> Maybe Rtmidi) -> Flags -> Maybe Doc
forall b a. Pretty b => (a -> Maybe b) -> a -> Maybe Doc
p  Flags -> Maybe Rtmidi
rtmidi
        , (Flags -> MidiIO) -> Flags -> Maybe Doc
forall b a. Pretty b => (a -> b) -> a -> Maybe Doc
pe Flags -> MidiIO
midiIO
        , (Flags -> MidiRT) -> Flags -> Maybe Doc
forall b a. Pretty b => (a -> b) -> a -> Maybe Doc
pe Flags -> MidiRT
midiRT
        , (Flags -> Maybe String) -> Flags -> Maybe Doc
forall b a. Pretty b => (a -> Maybe b) -> a -> Maybe Doc
p  Flags -> Maybe String
flagsVerbatim ]

instance Pretty AudioFileOutput where
    pretty :: AudioFileOutput -> Doc
pretty = [AudioFileOutput -> Maybe Doc] -> AudioFileOutput -> Doc
forall a. [a -> Maybe Doc] -> a -> Doc
fields
        [ (Maybe FormatSamples, Maybe FormatType) -> Maybe Doc
pSamplesAndType ((Maybe FormatSamples, Maybe FormatType) -> Maybe Doc)
-> (AudioFileOutput -> (Maybe FormatSamples, Maybe FormatType))
-> AudioFileOutput
-> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\AudioFileOutput
x -> (AudioFileOutput -> Maybe FormatSamples
formatSamples AudioFileOutput
x, AudioFileOutput -> Maybe FormatType
formatType AudioFileOutput
x))
        , ShowS
-> (AudioFileOutput -> Maybe String)
-> AudioFileOutput
-> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp (String -> ShowS
p2 String
"output") AudioFileOutput -> Maybe String
output
        , ShowS
-> (AudioFileOutput -> Maybe String)
-> AudioFileOutput
-> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp (String -> ShowS
p2 String
"input")  AudioFileOutput -> Maybe String
input
        , String -> (AudioFileOutput -> Bool) -> AudioFileOutput -> Maybe Doc
forall a. String -> (a -> Bool) -> a -> Maybe Doc
bo String
"--nosound" AudioFileOutput -> Bool
nosound
        , String -> (AudioFileOutput -> Bool) -> AudioFileOutput -> Maybe Doc
forall a. String -> (a -> Bool) -> a -> Maybe Doc
bo String
"--nopeaks" AudioFileOutput -> Bool
nopeaks
        , ShowS
-> (AudioFileOutput -> Maybe String)
-> AudioFileOutput
-> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp (String -> ShowS
p2 String
"d/Mither") ((AudioFileOutput -> Maybe String) -> AudioFileOutput -> Maybe Doc)
-> (AudioFileOutput -> Maybe String)
-> AudioFileOutput
-> Maybe Doc
forall a b. (a -> b) -> a -> b
$ (Dither -> String) -> Maybe Dither -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS
firstToLower ShowS -> (Dither -> String) -> Dither -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dither -> String
forall a. Show a => a -> String
show) (Maybe Dither -> Maybe String)
-> (AudioFileOutput -> Maybe Dither)
-> AudioFileOutput
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AudioFileOutput -> Maybe Dither
dither ]

pSamplesAndType :: (Maybe FormatSamples, Maybe FormatType) -> Maybe Doc
pSamplesAndType :: (Maybe FormatSamples, Maybe FormatType) -> Maybe Doc
pSamplesAndType (Maybe FormatSamples
ma, Maybe FormatType
mb) = (String -> Doc) -> Maybe String -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
forall a. Pretty a => a -> Doc
pretty (Maybe String -> Maybe Doc) -> Maybe String -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ case (Maybe FormatSamples
ma, Maybe FormatType
mb) of
    (Maybe FormatSamples
Nothing, Maybe FormatType
Nothing)  -> Maybe String
forall a. Maybe a
Nothing
    (Just FormatSamples
a, Maybe FormatType
Nothing)   -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> ShowS
p2 String
"format" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FormatSamples -> String
samplesToStr FormatSamples
a
    (Maybe FormatSamples
Nothing, Just FormatType
b)   -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> ShowS
p2 String
"format" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FormatType -> String
typeToStr FormatType
b
    (Just FormatSamples
a, Just FormatType
b)    -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> ShowS
p2 String
"format" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FormatSamples -> FormatType -> String
samplesAndTypeToStr FormatSamples
a FormatType
b
    where
        samplesToStr :: FormatSamples -> String
samplesToStr FormatSamples
x = case FormatSamples
x of
            FormatSamples
Bit24   -> String
"24bit"
            FormatSamples
FloatSamples -> String
"float"
            FormatSamples
_   -> ShowS
firstToLower ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FormatSamples -> String
forall a. Show a => a -> String
show FormatSamples
x

        typeToStr :: FormatType -> String
typeToStr = ShowS
firstToLower ShowS -> (FormatType -> String) -> FormatType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormatType -> String
forall a. Show a => a -> String
show

        samplesAndTypeToStr :: FormatSamples -> FormatType -> String
samplesAndTypeToStr FormatSamples
a FormatType
b = FormatSamples -> String
samplesToStr FormatSamples
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FormatType -> String
typeToStr FormatType
b

instance Pretty Dither where
    pretty :: Dither -> Doc
pretty = String -> Doc
forall a. Pretty a => a -> Doc
pretty (String -> Doc) -> (Dither -> String) -> Dither -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
p2 String
"dither" ShowS -> (Dither -> String) -> Dither -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dither -> String
forall a. Show a => a -> String
show

instance Pretty IdTags where
    pretty :: IdTags -> Doc
pretty = [IdTags -> Maybe Doc] -> IdTags -> Doc
forall a. [a -> Maybe Doc] -> a -> Doc
fields
        [ ShowS -> (IdTags -> Maybe String) -> IdTags -> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp (String -> ShowS
p3' String
"id_artist")       IdTags -> Maybe String
idArtist
        , ShowS -> (IdTags -> Maybe String) -> IdTags -> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp (String -> ShowS
p3' String
"id_comment")      IdTags -> Maybe String
idComment
        , ShowS -> (IdTags -> Maybe String) -> IdTags -> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp (String -> ShowS
p3' String
"id_copyright")    IdTags -> Maybe String
idCopyright
        , ShowS -> (IdTags -> Maybe String) -> IdTags -> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp (String -> ShowS
p3' String
"id_date")         IdTags -> Maybe String
idDate
        , ShowS -> (IdTags -> Maybe String) -> IdTags -> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp (String -> ShowS
p3' String
"id_software")     IdTags -> Maybe String
idSoftware
        , ShowS -> (IdTags -> Maybe String) -> IdTags -> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp (String -> ShowS
p3' String
"id_title")        IdTags -> Maybe String
idTitle ]
        where
            p3' :: String -> ShowS
p3' String
a String
b = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
substSpaces ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
p3 String
a String
b
            substSpaces :: Char -> Char
substSpaces Char
x
                | Char -> Bool
isSpace Char
x = Char
'_'
                | Bool
otherwise = Char
x

instance Pretty Rtaudio where
    pretty :: Rtaudio -> Doc
pretty Rtaudio
x = case Rtaudio
x of
        Rtaudio
PortAudio   -> String -> Doc
rt String
"PortAudio"
        Jack String
name String
ins String
outs -> String -> Doc
rt String
"jack" Doc -> Doc -> Doc
<+> String -> String -> String -> Doc
jackFields String
name String
ins String
outs
        Rtaudio
Mme -> String -> Doc
rt String
"mme"
        Rtaudio
Alsa  -> String -> Doc
rt String
"alsa"
        Rtaudio
CoreAudio -> String -> Doc
rt String
"auhal"
        Rtaudio
NoRtaudio   -> String -> Doc
rt String
"0"
        where
            rt :: String -> Doc
rt = String -> Doc
text (String -> Doc) -> ShowS -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
p3 String
"rtaudio"
            jackFields :: String -> String -> String -> Doc
jackFields String
name String
ins String
outs = [Doc] -> Doc
hsep
                [ String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> ShowS
p3 String
"jack_client" String
name
                , String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> ShowS
p3 String
"jack_inportname" String
ins
                , String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> ShowS
p3 String
"jack_outportname" String
outs ]

instance Pretty PulseAudio where
    pretty :: PulseAudio -> Doc
pretty PulseAudio
a = [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
text ([String] -> [Doc]) -> [String] -> [Doc]
forall a b. (a -> b) -> a -> b
$
        [ String -> ShowS
p3 String
"server" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ PulseAudio -> String
paServer PulseAudio
a
        , String -> ShowS
p3 String
"output_stream" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ PulseAudio -> String
paOutput PulseAudio
a
        , String -> ShowS
p3 String
"input_stream" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ PulseAudio -> String
paInput PulseAudio
a ]

instance Pretty MidiIO where
    pretty :: MidiIO -> Doc
pretty = [MidiIO -> Maybe Doc] -> MidiIO -> Doc
forall a. [a -> Maybe Doc] -> a -> Doc
fields
        [ ShowS -> (MidiIO -> Maybe String) -> MidiIO -> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp (String -> ShowS
p2 String
"midifile") MidiIO -> Maybe String
midiFile
        , ShowS -> (MidiIO -> Maybe String) -> MidiIO -> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp (String -> ShowS
p2 String
"midioutfile") MidiIO -> Maybe String
midiOutFile
        , ShowS -> (MidiIO -> Maybe String) -> MidiIO -> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp (String -> ShowS
p3 String
"mute_tracks") MidiIO -> Maybe String
muteTracks
        , String -> (MidiIO -> Bool) -> MidiIO -> Maybe Doc
forall a. String -> (a -> Bool) -> a -> Maybe Doc
bo String
"-+raw_controller_mode" MidiIO -> Bool
rawControllerMode
        , String -> (MidiIO -> Bool) -> MidiIO -> Maybe Doc
forall a. String -> (a -> Bool) -> a -> Maybe Doc
bo String
"--terminate-on-midi" MidiIO -> Bool
terminateOnMidi ]

instance Pretty MidiRT where
    pretty :: MidiRT -> Doc
pretty = [MidiRT -> Maybe Doc] -> MidiRT -> Doc
forall a. [a -> Maybe Doc] -> a -> Doc
fields
        [ ShowS -> (MidiRT -> Maybe String) -> MidiRT -> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp (String -> ShowS
p2 String
"midi-device")         MidiRT -> Maybe String
midiDevice
        , ShowS -> (MidiRT -> Maybe Int) -> MidiRT -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"midi-key")            MidiRT -> Maybe Int
midiKey
        , ShowS -> (MidiRT -> Maybe Int) -> MidiRT -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"midi-key-cps")        MidiRT -> Maybe Int
midiKeyCps
        , ShowS -> (MidiRT -> Maybe Int) -> MidiRT -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"midi-key-oct")        MidiRT -> Maybe Int
midiKeyOct
        , ShowS -> (MidiRT -> Maybe Int) -> MidiRT -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"midi-key-pch")        MidiRT -> Maybe Int
midiKeyPch
        , ShowS -> (MidiRT -> Maybe Int) -> MidiRT -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"midi-velocity")       MidiRT -> Maybe Int
midiVelocity
        , ShowS -> (MidiRT -> Maybe Int) -> MidiRT -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"midi-velocity-amp")   MidiRT -> Maybe Int
midiVelocityAmp
        , ShowS -> (MidiRT -> Maybe String) -> MidiRT -> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp (String -> ShowS
p1 String
"Q")                   MidiRT -> Maybe String
midiOutDevice ]

instance Pretty Rtmidi where
    pretty :: Rtmidi -> Doc
pretty Rtmidi
x = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> ShowS
p3 String
"rtmidi" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ case Rtmidi
x of
        Rtmidi
VirtualMidi -> String
"virtual"
        Rtmidi
PortMidi    -> String
"PortMidi"
        Rtmidi
AlsaMidi    -> String
"alsa"
        Rtmidi
AlsaSeq     -> String
"alsaseq"
        Rtmidi
CoreMidi    -> String
"coremidi"
        Rtmidi
MmeMidi     -> String
"mme"
        Rtmidi
WinmmeMidi  -> String
"winmme"
        Rtmidi
NoRtmidi    -> String
"0"

instance Pretty Displays where
    pretty :: Displays -> Doc
pretty = [Displays -> Maybe Doc] -> Displays -> Doc
forall a. [a -> Maybe Doc] -> a -> Doc
fields
        [ ShowS -> (Displays -> Maybe Int) -> Displays -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"csd-line-nums")   Displays -> Maybe Int
csdLineNums
        , (Displays -> Maybe DisplayMode) -> Displays -> Maybe Doc
forall b a. Pretty b => (a -> Maybe b) -> a -> Maybe Doc
p                         Displays -> Maybe DisplayMode
displayMode
        , ShowS -> (Displays -> Maybe Int) -> Displays -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"heartbeat")       Displays -> Maybe Int
displayHeartbeat
        , ShowS -> (Displays -> Maybe Int) -> Displays -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"messagelevel")    Displays -> Maybe Int
messageLevel
        , ShowS -> (Displays -> Maybe Int) -> Displays -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"m-amps")          Displays -> Maybe Int
mAmps
        , ShowS -> (Displays -> Maybe Int) -> Displays -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"m-range")         Displays -> Maybe Int
mRange
        , ShowS -> (Displays -> Maybe Int) -> Displays -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"m-warnings")      Displays -> Maybe Int
mWarnings
        , ShowS -> (Displays -> Maybe Int) -> Displays -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"m-dB")            Displays -> Maybe Int
mDb
        , ShowS -> (Displays -> Maybe Int) -> Displays -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"m-colours")       Displays -> Maybe Int
mColours
        , ShowS -> (Displays -> Maybe Int) -> Displays -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"m-benchmarks")    Displays -> Maybe Int
mBenchmarks
        , String -> (Displays -> Bool) -> Displays -> Maybe Doc
forall a. String -> (a -> Bool) -> a -> Maybe Doc
bo String
"-+msg_color"          Displays -> Bool
msgColor
        , String -> (Displays -> Bool) -> Displays -> Maybe Doc
forall a. String -> (a -> Bool) -> a -> Maybe Doc
bo String
"--verbose"            Displays -> Bool
displayVerbose
        , ShowS -> (Displays -> Maybe Int) -> Displays -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"list-opcodes")    Displays -> Maybe Int
listOpcodes ]

instance Pretty DisplayMode where
    pretty :: DisplayMode -> Doc
pretty DisplayMode
x = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ case DisplayMode
x of
        DisplayMode
NoDisplay           -> String
"--nodisplays"
        DisplayMode
PostScriptDisplay   -> String
"--postscriptdisplay"
        DisplayMode
AsciiDisplay        -> String
"--asciidisplay"

instance Pretty Config where
    pretty :: Config -> Doc
pretty = [Config -> Maybe Doc] -> Config -> Doc
forall a. [a -> Maybe Doc] -> a -> Doc
fields
        [ ShowS -> (Config -> Maybe Int) -> Config -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"hardwarebufsamps")    Config -> Maybe Int
hwBuf
        , ShowS -> (Config -> Maybe Int) -> Config -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"iobufsamps")          Config -> Maybe Int
ioBuf
        , ShowS -> (Config -> Maybe Int) -> Config -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"control-rate")        Config -> Maybe Int
newKr
        , ShowS -> (Config -> Maybe Int) -> Config -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"sample-rate")         Config -> Maybe Int
newSr
        , ShowS -> (Config -> Maybe String) -> Config -> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp (String -> ShowS
p2 String
"score-in")            Config -> Maybe String
scoreIn
        , String -> (Config -> Maybe (String, String)) -> Config -> Maybe Doc
forall (f :: * -> *) a.
Functor f =>
String -> (a -> f (String, String)) -> a -> f Doc
macro String
"omacro"                Config -> Maybe (String, String)
omacro
        , String -> (Config -> Maybe (String, String)) -> Config -> Maybe Doc
forall (f :: * -> *) a.
Functor f =>
String -> (a -> f (String, String)) -> a -> f Doc
macro String
"smacro"                Config -> Maybe (String, String)
smacro
        , String -> (Config -> Bool) -> Config -> Maybe Doc
forall a. String -> (a -> Bool) -> a -> Maybe Doc
bo String
"--sched"                  Config -> Bool
setSched
        , ShowS -> (Config -> Maybe Int) -> Config -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"sched")               Config -> Maybe Int
schedNum
        , (Config -> Maybe (Int, String)) -> Config -> Maybe Doc
forall (f :: * -> *) a a.
(Functor f, Show a) =>
(a -> f (a, String)) -> a -> f Doc
strset                        Config -> Maybe (Int, String)
strsetN
        , ShowS -> (Config -> Maybe String) -> Config -> Maybe Doc
forall a. ShowS -> (a -> Maybe String) -> a -> Maybe Doc
mp (String -> ShowS
p3 String
"skip_seconds")        ((Double -> String) -> Maybe Double -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> String
forall a. Show a => a -> String
show (Maybe Double -> Maybe String)
-> (Config -> Maybe Double) -> Config -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Maybe Double
skipSeconds)
        , ShowS -> (Config -> Maybe Int) -> Config -> Maybe Doc
forall a. ShowS -> (a -> Maybe Int) -> a -> Maybe Doc
mi (String -> ShowS
p2 String
"tempo")               Config -> Maybe Int
setTempo ]
        where
            macro :: String -> (a -> f (String, String)) -> a -> f Doc
macro String
name a -> f (String, String)
f = ((String, String) -> Doc) -> f (String, String) -> f Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Doc
forall a. Pretty a => a -> Doc
pretty (String -> Doc)
-> ((String, String) -> String) -> (String, String) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
phi) (f (String, String) -> f Doc)
-> (a -> f (String, String)) -> a -> f Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f (String, String)
f
                where phi :: (String, String) -> String
phi (String
a, String
b) = String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b
            strset :: (a -> f (a, String)) -> a -> f Doc
strset a -> f (a, String)
f = ((a, String) -> Doc) -> f (a, String) -> f Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Doc
forall a. Pretty a => a -> Doc
pretty (String -> Doc) -> ((a, String) -> String) -> (a, String) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, String) -> String
forall a. Show a => (a, String) -> String
phi) (f (a, String) -> f Doc) -> (a -> f (a, String)) -> a -> f Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f (a, String)
f
                where phi :: (a, String) -> String
phi (a
n, String
a) = String
"--strset" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (a -> String
forall a. Show a => a -> String
show a
n) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a

---------------------------------------------------
-- utilities

firstToLower :: String -> String
firstToLower :: ShowS
firstToLower String
x = case String
x of
    Char
a:String
as -> Char -> Char
toLower Char
a Char -> ShowS
forall a. a -> [a] -> [a]
: String
as
    []   -> []