{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Sound.Control.Exception.FinalException
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Exceptions for the other modules.
--

module Sound.Control.Exception.FinalException (
  FinalException(..)
  -- * Exception
  , catchEnd
) where

import Data.Typeable
import Control.Exception (Exception, catch, throw)
import System.Environment (getProgName)
import System.IO
import GHC.IO.Handle.Types (Newline( CRLF ), nativeNewline)

-- | Data type 'FinalException' is used to terminate the not needed further execution.
data FinalException = ExecutableNotProperlyInstalled | MaybePartiallyTrimmed | NotCreatedWithEffect String
  | InitialFileNotChanged String | NotCreated String | NotRecorded String | NoiseProfileNotCreatedB String | NoiseProfileNotCreatedE String
    | NotEnoughData String | NotCreatedWithEffects String | StrangeAnswer String String | NotFileNameGiven | DataFileNotClosed String
       | DataSoundFileNotRead String | UndefinedFunction String
          deriving ( Typeable )

instance Exception FinalException

instance Show FinalException where
  show :: FinalException -> String
show FinalException
ExecutableNotProperlyInstalled = String
"Sound.Control.Exception.FinalException.ExecutableNotProperlyInstalled: SoX is not properly installed in your system. Please, install it properly and then call the function again." String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Newline
nativeNewline Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF then String
"\r\n" else String
"\n")
  show FinalException
MaybePartiallyTrimmed = String
"Sound.Control.Exception.FinalException.MaybePartiallyTrimmed: The function did not create the needed file, but may be it trimmed the initial one (not enough)!"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Newline
nativeNewline Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF then String
"\r\n" else String
"\n")
  show (NotCreatedWithEffect String
xs) = String
"Sound.Control.Exception.FinalException.NotCreatedWithEffect: File was not created with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" effect!" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Newline
nativeNewline Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF then String
"\r\n" else String
"\n")
  show (InitialFileNotChanged String
xs) = String
"Sound.Control.Exception.FinalException.InitialFileNotChanged: The initial file " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" was not changed!" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Newline
nativeNewline Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF then String
"\r\n" else String
"\n")
  show (NotCreated String
xs) = String
"Sound.Control.Exception.FinalException.NotCreated: The function did not create the needed file " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"!" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Newline
nativeNewline Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF then String
"\r\n" else String
"\n")
  show (NotRecorded String
xs) = String
"Sound.Control.Exception.FinalException.NotRecorded: The file " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" was not recorded!" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Newline
nativeNewline Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF then String
"\r\n" else String
"\n")
  show (NoiseProfileNotCreatedB String
xs) = String
"Sound.Control.Exception.FinalException.NoiseProfileNotCreatedB: The noise profile " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".b.prof was not created!"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Newline
nativeNewline Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF then String
"\r\n" else String
"\n")
  show (NoiseProfileNotCreatedE String
xs) = String
"Sound.Control.Exception.FinalException.NoiseProfileNotCreatedE: The noise profile " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".e.prof was not created!"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Newline
nativeNewline Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF then String
"\r\n" else String
"\n")
  show (NotEnoughData String
xs) = String
"Sound.Control.Exception.FinalException.NotEnoughData: SoX cannot determine the number of the samples in the file " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"! May be it is a RAW file and it needs additional parameters to be processed." String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Newline
nativeNewline Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF then String
"\r\n" else String
"\n")
  show (NotCreatedWithEffects String
xs) = String
"Sound.Control.Exception.FinalException.NotCreatedWithEffects: File was not created with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShowS
forall a. [a] -> [a]
init ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",") ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Show a => a -> String
show) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
xs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" effects!"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Newline
nativeNewline Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF then String
"\r\n" else String
"\n")
  show (StrangeAnswer String
xs String
ys) = String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": the " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
ys String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" function gave a strange result!" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Newline
nativeNewline Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF then String
"\r\n" else String
"\n")
  show FinalException
NotFileNameGiven = String
"Please, specify as a command line argument at least a name of the resulting file (without its extension)! "
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Newline
nativeNewline Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF then String
"\r\n" else String
"\n")
  show (DataFileNotClosed String
xs) = String
"File " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not closed!" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Newline
nativeNewline Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF then String
"\r\n" else String
"\n")
  show (DataSoundFileNotRead String
xs) = String
"Data sound file " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not read!"  String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Newline
nativeNewline Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF then String
"\r\n" else String
"\n")
  show (UndefinedFunction String
xs) = String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": the function is undefined for the arguments. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Newline
nativeNewline Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF then String
"\r\n" else String
"\n")

-- | Function to work with exception 'FinalException' similarly to the example in the documentation for the 'catch' function. It throws an exception
-- to the thread where it is called.
catchEnd :: FinalException -> IO ()
catchEnd :: FinalException -> IO ()
catchEnd FinalException
e = do
  String
progName <- IO String
getProgName
  IO () -> (FinalException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (FinalException -> IO ()
forall a e. Exception e => e -> a
throw FinalException
e) (\FinalException
e0 -> Handle -> String -> IO ()
hPutStr Handle
stderr (String
progName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FinalException -> String
forall a. Show a => a -> String
show (FinalException
e0 :: FinalException)))