diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -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. diff --git a/Data/Phonetic/Languages/Base.hs b/Data/Phonetic/Languages/Base.hs new file mode 100644 --- /dev/null +++ b/Data/Phonetic/Languages/Base.hs @@ -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 diff --git a/Data/Phonetic/Languages/Undefined.hs b/Data/Phonetic/Languages/Undefined.hs new file mode 100644 --- /dev/null +++ b/Data/Phonetic/Languages/Undefined.hs @@ -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 + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/phonetic-languages-phonetics-basics.cabal b/phonetic-languages-phonetics-basics.cabal new file mode 100644 --- /dev/null +++ b/phonetic-languages-phonetics-basics.cabal @@ -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