phonetic-languages-phonetics-basics (empty) → 0.1.0.0

raw patch · 6 files changed

+391/−0 lines, 6 filesdep +basesetup-changed

Dependencies added: base

Files

• ChangeLog.md +5/−0
• Data/Phonetic/Languages/Base.hs +243/−0
• Data/Phonetic/Languages/Undefined.hs +95/−0
• LICENSE +20/−0
• Setup.hs +2/−0
• phonetic-languages-phonetics-basics.cabal +26/−0

@@ -0,0 +1,5 @@+# Revision history for phonetic-languages-phonetics-basics++## 0.1.0.0 -- 2021-04-19++* First version. Released on an unsuspecting world.

@@ -0,0 +1,243 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE BangPatterns #-}+-- |+-- Module      :  Data.Phonetic.Languages.Base+-- Copyright   :  (c) OleksandrZhabenko 2021+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- This is a computational scheme for generalized usage of the phonetic languages approach. +-- It is intended to be exported qualified, so that the functions in every language+-- implementation have the same names and signatures as these ones and the data type used here.+-- It is may be not the most efficient implementation.+-- ++module Data.Phonetic.Languages.Base (+  -- * Phonetics representation data type for the phonetic languages approach.+  PhoneticsRepresentationPL(..)+  , PhoneticsRepresentationPLX(..)+  , Generations+  , InterGenerationsString+  , WritingSystemPRPLX+  , GWritingSystemPRPLX+  , PhoneticRepresentationXInter+  , IGWritingSystemPRPLX+  , fromX2PRPL+  , fromPhoneticRX+  -- * Functions to work with the one.+  -- ** Predicates+  , isPRC+  , isPRAfterC+  , isPRBeforeC+  , isPREmptyC+  -- ** Convert to the 'PhoneticsRepresentationPLX'.+  , stringToXSG+  , stringToXG+  , stringToXS+  --, stringToX+  , string2X+  -- ** Apply conversion from 'PhoneticsRepresentationPLX'.+  , rulesX+) where++import Data.List (sortBy,groupBy,nub,(\\),find,partition)+import GHC.Int (Int8(..))+import Data.Maybe (isJust,fromJust)+import Data.Either++-- | The intended conversion to the syllables for a written word is: +-- @+-- toSyllables . map rulesPR . stringToPRPL+-- @+-- The syllable after this is encoded with the representation with every 'Char' being some phonetic language phenomenon.+-- To see its usual written representation, use the defined 'showRepr' function (please, implement your own one).+data PhoneticsRepresentationPL = PR { string :: String, afterString :: String, beforeString :: String } |+  PRAfter { string :: String, afterString :: String } |+  PRBefore { string :: String, beforeString :: String } |+  PREmpty { string :: String }+    deriving (Eq, Ord)++-- | Extended variant of the 'PhoneticRepresentationPL' data type where the information for the 'Char' is encoded into the+-- data itself. Is easier to implement the rules in the separate file by just specifying the proper and complete list of+-- 'PhoneticsRepresentationPLX' values. +data PhoneticsRepresentationPLX = PRC { stringX :: String, afterStringX :: String, beforeStringX :: String, char :: Char } |+  PRAfterC { stringX :: String, afterStringX :: String, char :: Char } |+  PRBeforeC { stringX :: String, beforeStringX :: String, char :: Char } |+  PREmptyC { stringX :: String, char :: Char }+    deriving (Eq, Ord)++isPRC :: PhoneticsRepresentationPLX -> Bool+isPRC (PRC _ _ _ _) = True+isPRC _ = False++isPRAfterC :: PhoneticsRepresentationPLX -> Bool+isPRAfterC (PRAfterC _ _ _) = True+isPRAfterC _ = False++isPRBeforeC :: PhoneticsRepresentationPLX -> Bool+isPRBeforeC (PRBeforeC _ _ _) = True+isPRBeforeC _ = False++isPREmptyC :: PhoneticsRepresentationPLX -> Bool+isPREmptyC (PREmptyC _ _) = True+isPREmptyC _ = False++fromX2PRPL :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPL+fromX2PRPL (PREmptyC xs _) = PREmpty xs+fromX2PRPL (PRAfterC xs ys _) = PRAfter xs ys+fromX2PRPL (PRBeforeC xs zs _) = PRBefore xs zs+fromX2PRPL (PRC xs ys zs _) = PR xs ys zs+{-# INLINE fromX2PRPL #-}++-- | An analogue of the 'rulesPR' function for 'PhoneticsRepresentationPLX'. +rulesX :: PhoneticsRepresentationPLX -> Char+rulesX = char+{-# INLINE rulesX #-}++stringToXS :: WritingSystemPRPLX -> String -> [String]+stringToXS xs ys = ks : stringToX' zss l ts+  where !zss = nub . map stringX $ xs+        !l = maximum . map length $ zss+        f ys l zss = splitAt ((\xs -> if null xs then 1 else head xs) . filter (\n -> elem (take n ys) zss) $ [l,l-1..1]) ys+        {-# INLINE f #-}+        (!ks,!ts) = f ys l zss+        stringToX' rss m vs = bs : stringToX' rss m us+           where (!bs,!us) = f vs m rss++{-| Uses the simplest variant of the 'GWritingSystemPRPLX' with just two generations where all the 'PREmptyC' elements in the+'WritingSystemPRPLX' are used in the last order. Can be suitable for simple languages (e. g. Esperanto).+-}+string2X :: WritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]+string2X xs = stringToXG [(zs,1),(ys,0)]+  where (ys,zs) = partition isPREmptyC xs+{-# INLINE string2X #-}++{-| Each generation represents a subset of rules for representation transformation. The 'PhoneticsRepresentationPLX'+are groupped by the generations so that in every group with the same generation number ('Int8' value, typically starting+from 1) the rules represented have no conflicts with each other (this guarantees that they can be applied simultaneously+without the danger of incorrect interference). Usage of 'Generations' is a design decision and is inspired by the+GHC RULES pragma and the GHC compilation multistage process. +-}+type Generations = Int8++{-| Each value represents temporary intermediate resulting 'String' data to be transformed further into the representation.+-}+type InterGenerationsString = String++{-| If the list here is proper and complete, then it usually represents the whole writing system of the language. For proper usage,+the list must be sorted in the ascending order.+-}+type WritingSystemPRPLX = [PhoneticsRepresentationPLX]++{-| The \'dynamic\' representation of the general writing system that specifies what transformations are made simultaneously+during the conversion to the phonetic languages phonetics representation. During transformations those elements that have+greater 'Generations' are used earlier than others. The last ones are used those elements with the 'Generations' element+equal to 0 that must correspond to the 'PREmptyC' constructor-built records. For proper usage, the lists on the first+place of the tuples must be sorted in the ascending order.+-}+type GWritingSystemPRPLX = [([PhoneticsRepresentationPLX],Generations)]++type PhoneticRepresentationXInter = Either PhoneticsRepresentationPLX InterGenerationsString++fromPhoneticRX :: [PhoneticsRepresentationPLX] -> [PhoneticRepresentationXInter] -> [PhoneticsRepresentationPLX]+fromPhoneticRX ts = concatMap (fromInter2X ts)+  where fromInter2X :: [PhoneticsRepresentationPLX] -> PhoneticRepresentationXInter -> [PhoneticsRepresentationPLX]+        fromInter2X _ (Left x) = [x]+        fromInter2X ys (Right z) = filter ((== z) . stringX) ys++{-| The \'dynamic\' representation of the process of transformation for the general writing system during the conversion.+Is not intended to be produced by hand, but automatically by programs.+-}+type IGWritingSystemPRPLX = [(PhoneticRepresentationXInter,Generations)]++stringToXSG :: GWritingSystemPRPLX -> Generations -> String -> IGWritingSystemPRPLX+stringToXSG xs n ys+ | any ((== n) . snd) xs && n > 0 = stringToXSGI (xs \\ ts) (n - 1) . xsG zs n $ pss+ | otherwise = error "Data.Phonetic.Languages.Base.stringToXSG: Not defined for these first two arguments. "+     where !pss = stringToXS (concatMap fst xs) ys -- ps :: [String]+           !ts = filter ((== n) . snd) $ xs -- ts :: GWritingSystemPRPLX+           !zs = if null ts then [] else fst . head $ ts -- zs :: PhoneticRepresentationX+           xsG rs n (k1s:k2s:k3s:kss) -- xsG :: [PhoneticRepresentationPLX] -> [String] -> Generations -> IGWritingSystemPRPLX+            | any (\rec -> afterStringX rec == k3s && beforeStringX rec == k1s) . filter ((== k2s) . stringX) $ r2s+                = (Right k1s,n - 1):(Left . fromJust . find (\rec -> afterStringX rec == k3s && beforeStringX rec == k1s &&+                    stringX rec == k2s) $ r2s,n):xsG rs n (k3s:kss)+            | any (\rec -> afterStringX rec == k2s) . filter ((== k1s) . stringX) $ r3s+                = (Left . fromJust . find (\rec -> afterStringX rec == k2s &&+                    stringX rec == k1s) $ r3s,n):xsG rs n (k2s:k3s:kss)+            | any (\rec -> beforeStringX rec == k1s) . filter ((== k2s) . stringX) $ r4s+                = (Right k1s,n - 1):(Left . fromJust . find (\rec -> beforeStringX rec == k1s &&+                    stringX rec == k2s) $ r4s,n):xsG rs n (k3s:kss)+            | any ((== k1s) . stringX) r5s = (Left . fromJust . find (\rec -> stringX rec == k1s) $ r5s,n):xsG rs n (k2s:k3s:kss)+            | otherwise = (Right k1s,n - 1):xsG rs n (k2s:k3s:kss)+               where [!r2s,!r3s,!r4s,!r5s] = map (\f -> filter f rs) [isPRC, isPRAfterC, isPRBeforeC, isPREmptyC]+           xsG rs n (k1s:k2s:kss)+            | any (\rec -> afterStringX rec == k2s) . filter ((== k1s) . stringX) $ r3s+                = (Left . fromJust . find (\rec -> afterStringX rec == k2s &&+                    stringX rec == k1s) $ r3s,n):xsG rs n (k2s:kss)+            | any (\rec -> beforeStringX rec == k1s) . filter ((== k2s) . stringX) $ r4s+                = (Right k1s,n - 1):(Left . fromJust . find (\rec -> beforeStringX rec == k1s &&+                    stringX rec == k2s) $ r4s,n):xsG rs n (kss)+            | any ((== k1s) . stringX) r5s = (Left . fromJust . find (\rec -> stringX rec == k1s) $ r5s,n):xsG rs n (k2s:kss)+            | otherwise = (Right k1s,n - 1):xsG rs n (k2s:kss)+               where [r3s,!r4s,!r5s] = map (\f -> filter f rs) [isPRAfterC, isPRBeforeC, isPREmptyC]+           xsG rs n [k1s]+            | any ((== k1s) . stringX) r5s = [(Left . fromJust . find (\rec -> stringX rec == k1s) $ r5s,n)]+            | otherwise = [(Right k1s,n - 1)]+               where !r5s = filter isPREmptyC rs+           xsG rs n [] = []++{-|+Is used internally in the 'stringToXSG' and 'stringToXG' functions respectively. +-}+stringToXSGI :: GWritingSystemPRPLX -> Generations -> IGWritingSystemPRPLX -> IGWritingSystemPRPLX+stringToXSGI xs n ys+ | n > 0 = stringToXSGI (xs \\ ts) (n - 1) . xsGI zs n $ ys+ | otherwise = ys+     where !ts = filter ((== n) . snd) xs -- ts :: GWritingSystemPRPLX+           !zs = concatMap fst ts -- zs :: PhoneticRepresentationX+           xsGI rs n (k1s:k2s:k3s:kss) -- xsGI :: [PhoneticRepresentationPLX] -> Generations -> IGWritingSystemPRPLX -> IGWritingSystemPRPLX+            | snd k2s == n && (any (\rec -> either (const False) (== afterStringX rec) (fst k3s) &&+               either (const False) (== beforeStringX rec) (fst k1s)) .+                filter (\rec -> either (const False) (== stringX rec) (fst k2s)) $ r2s) +                 = (fst k1s,n - 1):(Left . fromJust . find (\rec -> either (const False) (== afterStringX rec) (fst k3s) &&+                   either (const False) (== beforeStringX rec) (fst k1s) && either (const False) (== stringX rec) (fst k2s)) $+                     r2s,n) : xsGI rs n (k3s:kss)+            | snd k1s == n && (any (\rec -> either (const False) (== afterStringX rec) (fst k2s)) .+               filter (\rec -> either (const False) (== stringX rec) (fst k1s)) $ r3s)+                = (Left . fromJust . find (\rec -> either (const False) (== afterStringX rec) (fst k2s) &&+                    either (const False) (== stringX rec) (fst k1s)) $ r3s,n):xsGI rs n (k2s:k3s:kss)+            | snd k2s == n && (any (\rec -> either (const False) (== beforeStringX rec) (fst k1s)) .+               filter (\rec -> either (const False) (== stringX rec) (fst k2s)) $ r4s)+                = (fst k1s,n - 1):(Left . fromJust . find (\rec -> either (const False) (== beforeStringX rec) (fst k1s) &&+                    either (const False) (== stringX rec) (fst k2s)) $ r4s,n):xsGI rs n (k3s:kss)+            | snd k1s == n && (any (\rec -> either (const False) (== stringX rec) (fst k1s)) r5s) = (Left . fromJust .+               find (\rec -> either (const False) (== stringX rec) (fst k1s)) $ r5s, n):xsGI rs n (k2s:k3s:kss)+            | otherwise = (fst k1s,n - 1):xsGI rs n (k2s:k3s:kss)+               where [!r2s,!r3s,!r4s,!r5s] = map (\f -> filter f rs) [isPRC, isPRAfterC, isPRBeforeC, isPREmptyC]+           xsGI rs n (k1s:k2s:kss)+            | snd k1s == n && (any (\rec -> either (const False) (== afterStringX rec) (fst k2s)) .+               filter (\rec -> either (const False) (== stringX rec) (fst k1s)) $ r3s)+                = (Left . fromJust . find (\rec -> either (const False) (== afterStringX rec) (fst k2s) &&+                    either (const False) (== stringX rec) (fst k1s)) $ r3s,n):xsGI rs n (k2s:kss)+            | snd k2s == n && (any (\rec -> either (const False) (== beforeStringX rec) (fst k1s)) .+               filter (\rec -> either (const False) (== stringX rec) (fst k2s)) $ r4s)+                = (fst k1s,n - 1):(Left . fromJust . find (\rec -> either (const False) (== beforeStringX rec) (fst k1s) &&+                    either (const False) (== stringX rec) (fst k2s)) $ r4s,n):xsGI rs n (kss)+            | snd k1s == n && (any (\rec -> either (const False) (== stringX rec) (fst k1s)) r5s) = (Left . fromJust .+               find (\rec -> either (const False) (== stringX rec) (fst k1s)) $ r5s,n):xsGI rs n (k2s:kss)+            | otherwise = (fst k1s,n - 1):xsGI rs n (k2s:kss)+               where [r3s,!r4s,!r5s] = map (\f -> filter f rs) [isPRAfterC, isPRBeforeC, isPREmptyC]+           xsGI rs n [k1s]+            | snd k1s == n && (any (\rec -> either (const False) (== stringX rec) (fst k1s)) r5s) = [(Left . fromJust .+                find (\rec -> either (const False) (== stringX rec) (fst k1s)) $ r5s,n)]+            | otherwise = [(fst k1s,n - 1)]+               where !r5s = filter isPREmptyC rs+           xsGI rs n [] = []+        +{-| The full conversion function. Applies conversion into representation using the 'GWritingSystemPRPLX' provided.+-}+stringToXG :: GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]+stringToXG xs ys = fromPhoneticRX ts . map fst . stringToXSG xs n $ ys+ where n = maximum . map snd $ xs+       !ts = concatMap fst . filter ((== 0) . snd) $ xs

@@ -0,0 +1,95 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Data.Phonetic.Languages.Undefined+-- Copyright   :  (c) OleksandrZhabenko 2021+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- This is a computational scheme for generalized usage of the phonetic languages approach. +-- The functions themselves are 'undefined' but with some type. They are just templates and some general idea.+-- Please, provide your own implementation instead of using these ones.++module Data.Phonetic.Languages.Undefined {-# WARNING "This module contains just some templates and ideas. Please, provide the analogous functions by yourself, these ones while used returns 'undefined'. " #-} (+  -- * Convert to the 'PhoneticsRepresentationPL'.+  stringToPRPL+  -- * Apply conversion from 'PhoneticsRepresentationPL'.+  , fromPRPL2X+  , rules+  , rulesPR+  -- * Convert from the 'PhoneticsRepresentationPL' after applying 'rulesPR' function+  -- or from the 'PhoneticsRepresentationPLX' after applying 'rulesX' function.+  , showRepr+  -- * Divide into syllables after both conversions.+  , toSyllables+) where++import Data.Phonetic.Languages.Base++{-| Every 'Char' value represents here the phonetic phenomenon, mostly (usually, or often) some phoneme.+-}+rulesPR :: PhoneticsRepresentationPL -> Char+rulesPR (PREmpty xs) = rules xs Nothing Nothing+rulesPR (PRAfter xs ys) = rules xs (Just ys) Nothing+rulesPR (PRBefore xs zs) = rules xs Nothing (Just zs)+rulesPR (PR xs ys zs) = rules xs (Just ys) (Just zs)+{-# INLINE rulesPR #-}++fromPRPL2X :: PhoneticsRepresentationPL -> PhoneticsRepresentationPLX+fromPRPL2X y@(PREmpty xs) = PREmptyC xs (rulesPR y)+fromPRPL2X y@(PRAfter xs ys) = PRAfterC xs ys (rulesPR y)+fromPRPL2X y@(PRBefore xs zs) = PRBeforeC xs zs (rulesPR y)+fromPRPL2X y@(PR xs ys zs) = PRC xs ys zs (rulesPR y)+{-# INLINE fromPRPL2X #-}++{-| The text is converted to the phonetic languages representation by this function.+It is intended to be exported qualified, so that the function in every language+implementation has the same name and signature as here and the data type is used there.+Please, use this function only as a type and semantics template and implement your own one where needed.+If you can define some function 'stringToPRPL' where every 'PhoneticRepresentationPL' corresponds to the distinguishable+phonetic phenomenae then it is a considerable application for the possible phonetic languages approach usability for the+data.+-}+stringToPRPL :: String -> [PhoneticsRepresentationPL]+stringToPRPL = undefined++{-| Every 'Char' value represents here the phonetic phenomenon, mostly (usually, or often) some phoneme.+It is intended to be exported qualified, so that the function in every language+implementation has the same name and signature as here and the data type is used there.+Please, use this function only as a type and semantics template and implement your own one where needed.+-}+rules+  :: String -- ^ Is gotten as 'string' from 'PhoneticsRepresentationPL'+  -> Maybe String -- ^ Is gotten as 'afterString' from 'PhoneticsRepresentationPL'. Is 'Nothing' if there is no any.+  -> Maybe String -- ^ Is gotten as 'beforeString' from 'PhoneticsRepresentationPL'. Is 'Nothing' if there is no any.+  -> Char +rules = undefined++{-| Converts the converted from the 'PhoneticsRepresentationPL' conversion 'String' to syllables. +It is intended to be exported qualified, so that the function in every language+implementation has the same name and signature as here and the data type is used there.+Please, use this function only as a type and semantics template and implement your own one where needed.+-}+toSyllables :: String -> [String]+toSyllables = undefined++{-| Converts the converted from the 'PhoneticsRepresentationPL' conversion 'Char' to the usual written+in the language 'String' for the phenomenon. +It is intended to be exported qualified, so that the function in every language+implementation has the same name and signature as here and the data type is used there.+Please, use this function only as a type and semantics template and implement your own one where needed.+After you have defined the 'rules' and 'showRepr' functions, you can implement the instance for 'Show' class+for the 'PhoneticRepresentationPL' as:+instance Show PhoneticsRepresentationPL where+  show = showRepr . rulesPR+  {-# INLINE show #-}++Similarly for the 'PhoneticsRepresentationPLX':+instance Show PhoneticsRepresentationPLX where+  show = showRepr . rulesX+  {-# INLINE show #-}+-}+showRepr :: Char -> String+showRepr = undefined+

@@ -0,0 +1,20 @@+Copyright (c) 2021 Oleksandr Zhabenko++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,26 @@+-- Initial phonetic-languages-phonetics-basics.cabal generated by cabal+-- init.  For further documentation, see+-- http://haskell.org/cabal/users-guide/++name:                phonetic-languages-phonetics-basics+version:             0.1.0.0+synopsis:            A library for working with generalized phonetic languages usage.+description:         There already exists a Ukrainian implementation for the phonetic languages approach published at: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array. It is optimized for the Ukrainian only and needs to be rewritten for every new language mostly from scratch using it as a template. To avoid this boilerplate, this one is provided. It can be used for different languages and even for music or other fields. +homepage:            https://hackage.haskell.org/package/phonetic-languages-phonetics-basics+license:             MIT+license-file:        LICENSE+author:              OleksandrZhabenko+maintainer:          olexandr543@yahoo.com+copyright:           Oleksandr Zhabenko+category:            Language+build-type:          Simple+extra-source-files:  ChangeLog.md+cabal-version:       >=1.10++library+  exposed-modules:     Data.Phonetic.Languages.Undefined, Data.Phonetic.Languages.Base+  -- other-modules:+  other-extensions:    BangPatterns+  build-depends:       base >=4.8 && <4.15+  -- hs-source-dirs:+  default-language:    Haskell2010