-- |
-- Module      :  MMSyn6Ukr.Show7s
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Can be used to show a sorted list of the Ukrainian sounds 
-- representations that for mmsyn7 series of programs. Is taken from 
-- the mmsyn7s package.
--

module MMSyn6Ukr.Show7s (
  show7s
) where

import qualified Data.Vector as V
import Data.List (sort, nub)
import Melodics.Ukrainian (convertToProperUkrainian)

-- | Function takes a Ukrainian text being a @String@ and returns a sorted list of the Ukrainian sounds representations that can be used further in mmsyn7 series of
-- programs.
show7s :: String -> [String]
show7s :: String -> [String]
show7s = [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector String -> [String]
forall a. Vector a -> [a]
V.toList (Vector String -> [String])
-> (String -> Vector String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> Vector String -> Vector String
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (\String
x -> String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"-" Bool -> Bool -> Bool
&& String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"1" Bool -> Bool -> Bool
&& String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"0") (Vector String -> Vector String)
-> (String -> Vector String) -> String -> Vector String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Vector String
convertToProperUkrainian