packages feed

mmsyn6ukr-array-0.3.3.0: Melodics/Ukrainian/Arr.hs

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

-- |
-- Module      :  Melodics.Ukrainian.Arr
-- Copyright   :  (c) OleksandrZhabenko 2019-2022
-- License     :  MIT
-- Maintainer  :  olexandr543@yahoo.com
--
-- Functions provide functionality of a musical instrument synthesizer or for Ukrainian speech synthesis
-- especially for poets, translators and writers.
--

module Melodics.Ukrainian.Arr (
  appendULFile
  , convertToProperUkrainian
  , isUkrainian
) where

import qualified Data.ByteString.Char8 as B
import System.IO
import CaseBi.Arr
import qualified Data.Foldable as F
import GHC.Arr
import Melodics.Ukrainian.ArrInt8
import Paths_mmsyn6ukr_array

{-|
The first version has been initially inspired by: https://mail.haskell.org/pipermail/beginners/2011-October/008649.html
-}

-- | The function that actually produces a .raw file. Since 0.3.0.0 version changed the type.
appendULFile ::  FlowSound -> Handle -> IO ()
appendULFile xss hdl | not (null xss) =
  do
    dataFileList <- mapM getDataFileName
      ["0.ul", "A.ul", "B.ul", "C.ul", "D.ul", "E.ul", "F.ul", "G.ul", "H.ul",
        "I.ul", "J.ul", "K.ul", "L.ul", "M.ul", "N.ul", "O.ul", "P.ul", "Q.ul", "R.ul",
          "S.ul", "T.ul", "U.ul", "V.ul", "W.ul", "X.ul", "Y.ul", "Z.ul", "a.ul", "b.ul", "c.ul",
            "d.ul", "e.ul", "f.ul"]
    dataArray0 <- mapM B.readFile $! dataFileList
    let !dataArray = listArray (0,32) dataArray0
    mapM_ (\u ->
      if F.all (\z -> B.length z > 0) dataArray
        then let rs =  tail . dropWhile (/= ' ') . takeWhile (/= '}') . show $ hdl in do
          hClose hdl
          closedHdl <- hIsClosed hdl
          if closedHdl
            then do
                   B.appendFile rs $ unsafeAt dataArray . getBFstLSorted' 0 [(1,1),(2,8),(3,17),(4,23),(5,11),(6,31),
                      (7,30),(8,7),(10,9),(15,2),(17,5),(19,32),(21,4),(23,6),(25,10),(27,12),(28,14),(30,15),(32,16),
                        (34,19),(36,3),(38,26),(39,28),(41,29),(43,24),(45,13),(47,18),(49,20),(50,22),(52,25),(54,21),
                          (66,27)] $ u
            else error "File is not closed!"
        else error "Data sound file is not read!") xss
    hClose hdl
                       | otherwise = return ()

-- | The function that converts a written Ukrainian text into the sounding in the program phonetical respesentation.
-- It is not exact phonetically but you can make for yourself a general impression of the Ukrainian sounding.
convertToProperUkrainian :: String -> [String]
convertToProperUkrainian xs = new2OldRepresentation . convertToProperUkrainianI8 $ xs
  where new2OldRepresentation :: FlowSound -> [String]
        new2OldRepresentation ys = map f $ ys
          where f = getBFstLSorted' "" [(1,"\1072"),(2,"\1077"),(3,"\1086"),(4,"\1091"),(5,"\1080"),(6,"\1110"),
                      (7,"\1100"),(8,"\1076\1079"),(10,"\1078"),(15,"\1073"),(17,"\1076"),(19,"\1169"),(21,"\1075"),
                        (23,"\1076\1078"),(25,"\1079"),(27,"\1081"),(28,"\1083"),(30,"\1084"),(32,"\1085"),(34,"\1088"),
                          (36,"\1074"),(38,"\1094"),(39,"\1095"),(41,"\1096"),(43,"\1092"),(45,"\1082"),(47,"\1087"),
                            (49,"\1089"),(50,"\1090"),(52,"\1093"),(54,"\1089\1100"),(66,"\1094\1100"),(101,"-")]

isUkrainian :: Char -> Bool
isUkrainian = isUkrainianL