-- |
-- Module      :  EspeakNG_IPA
-- Copyright   :  (c) OleksandrZhabenko 2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Is intended to use internally \"espeak-ng\" or \"espeak\" executable to produce the IPA phonemes output
-- of the given 'String'.
-- The prerequisite is installed espeak-ng or espeak executable in the path that is in the PATH
-- environment variable. 

module EspeakNG_IPA where

import System.Process (readProcessWithExitCode)
import EndOfExe (showE)
import System.Exit (ExitCode(..))
import Data.Maybe (fromJust)

{-| Given a language 'String' supported by the espeak-ng or espeak (which one is installed properly, the espeak-ng
is a preferred one) and the needed text returns the IPA representation. Is just some wrapper around the espeak functionality. -}
espeakNG_IPA :: String -> String -> IO String
espeakNG_IPA :: String -> String -> IO String
espeakNG_IPA = (String -> String) -> String -> String -> IO String
espeakNG_IPA_G String -> String
forall a. a -> a
id
{-# INLINE espeakNG_IPA #-}

{-| Given a language 'String' supported by the espeak-ng or espeak (which one is installed properly, the espeak-ng
is a preferred one) and the needed text returns the IPA representation filtered of the \'ˈ\' and \':\' characters.
Is just some wrapper around the espeak functionality. -}
espeakNG_IPA1 :: String -> String -> IO String
espeakNG_IPA1 :: String -> String -> IO String
espeakNG_IPA1 = (String -> String) -> String -> String -> IO String
espeakNG_IPA_G ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'ˈ' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':'))
{-# INLINE espeakNG_IPA1 #-}

{-| Given a language 'String' supported by the espeak-ng or espeak (which one is installed properly, the espeak-ng
is a preferred one) and the needed text prints the IPA representation. Is just some wrapper around the espeak functionality. -}  
espeakNG_IPA_ :: String -> String -> IO ()
espeakNG_IPA_ :: String -> String -> IO ()
espeakNG_IPA_ = (String -> String) -> String -> String -> IO ()
espeakNG_IPA_G_ String -> String
forall a. a -> a
id
{-# INLINE espeakNG_IPA_ #-}

{-| Given a language 'String' supported by the espeak-ng or espeak (which one is installed properly, the espeak-ng
is a preferred one) and the needed text prints the IPA representation filtered of the \'ˈ\' and \':\' characters.
Is just some wrapper around the espeak functionality. -}  
espeakNG_IPA1_ :: String -> String -> IO ()
espeakNG_IPA1_ :: String -> String -> IO ()
espeakNG_IPA1_ = (String -> String) -> String -> String -> IO ()
espeakNG_IPA_G_ ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'ˈ' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':'))
{-# INLINE espeakNG_IPA1_ #-}

{-| Given a conversion function that is applied to the resulting 'String' before it is returned, a language
'String' supported by the espeak-ng or espeak (which one is installed properly, the espeak-ng
is a preferred one) and the needed text returns the IPA representation. Is just some wrapper around the espeak functionality. -}
espeakNG_IPA_G :: (String -> String) -> String -> String -> IO String
espeakNG_IPA_G :: (String -> String) -> String -> String -> IO String
espeakNG_IPA_G String -> String
g String
voice String
xs =
 case String -> Maybe String
showE String
"espeak-ng" of
   Just String
path -> String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
path (String
"-xq"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
"--ipa"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
"-v"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String
voice]) String
xs IO (ExitCode, String, String)
-> ((ExitCode, String, String) -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
     \(ExitCode
hcode,String
hout,String
herr) -> case ExitCode
hcode of
        ExitCode
ExitSuccess -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String
g (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
hout)
        ExitCode
_ -> String -> IO String
forall a. HasCallStack => String -> a
error (String
"EspeakNG_IPA.espeakNG_IPA_G: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
herr)
   Maybe String
_ -> case String -> Maybe String
showE String
"espeak" of
          Just String
path2 -> String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
path2 (String
"-xq"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
"--ipa"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
"-v"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String
voice]) String
xs IO (ExitCode, String, String)
-> ((ExitCode, String, String) -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            \(ExitCode
hcode,String
hout,String
herr) -> case ExitCode
hcode of
               ExitCode
ExitSuccess -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String
g (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
hout)
               ExitCode
_ -> String -> IO String
forall a. HasCallStack => String -> a
error (String
"EspeakNG_IPA.espeakNG_IPA_G: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
herr)
          Maybe String
_ -> String -> IO String
forall a. HasCallStack => String -> a
error (String
"EspeakNG_IPA.espeakNG_IPA_G: No espeak or espeak-ng executable is installed in the PATH directories. ")          

{-| Given a conversion function that is applied to the resulting 'String' before it is printed, a language
'String' supported by the espeak-ng or espeak (which one is installed properly, the espeak-ng
is a preferred one) and the needed text prints the IPA representation. Is just some wrapper around the espeak functionality. -}
espeakNG_IPA_G_ :: (String -> String) -> String -> String -> IO ()
espeakNG_IPA_G_ :: (String -> String) -> String -> String -> IO ()
espeakNG_IPA_G_ String -> String
g String
voice String
xs =
 case String -> Maybe String
showE String
"espeak-ng" of
   Just String
path -> String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
path (String
"-xq"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
"--ipa"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
"-v"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String
voice]) String
xs IO (ExitCode, String, String)
-> ((ExitCode, String, String) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
     \(ExitCode
hcode,String
hout,String
herr) -> case ExitCode
hcode of
        ExitCode
ExitSuccess -> String -> IO ()
putStrLn (String -> String
g (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
hout)
        ExitCode
_ -> String -> IO ()
forall a. HasCallStack => String -> a
error (String
"EspeakNG_IPA.espeakNG_IPA_G_: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
herr)
   Maybe String
_ -> case String -> Maybe String
showE String
"espeak" of
          Just String
path2 -> String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
path2 (String
"-xq"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
"--ipa"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
"-v"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String
voice]) String
xs IO (ExitCode, String, String)
-> ((ExitCode, String, String) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            \(ExitCode
hcode,String
hout,String
herr) -> case ExitCode
hcode of
               ExitCode
ExitSuccess -> String -> IO ()
putStrLn (String -> String
g (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
hout)
               ExitCode
_ -> String -> IO ()
forall a. HasCallStack => String -> a
error (String
"EspeakNG_IPA.espeakNG_IPA_G_: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
herr)
          Maybe String
_ -> String -> IO ()
forall a. HasCallStack => String -> a
error (String
"EspeakNG_IPA.espeakNG_IPA_G_: No espeak or espeak-ng executable is installed in the PATH directories. ")