phonetic-languages-phonetics-basics 0.3.2.0 → 0.3.3.0

raw patch · 4 files changed

+115/−10 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• Data/Phonetic/Languages/Base.hs +66/−3
• Data/Phonetic/Languages/Syllables.hs +42/−5
• phonetic-languages-phonetics-basics.cabal +2/−2

@@ -30,3 +30,8 @@ ## 0.3.2.0 -- 2021-04-21  * Third version revised B. Fixed issue with semantics of the 'divCnsnts' function and related data types. ++## 0.3.3.0 -- 2021-04-24++* Third version revised C. Some code improvements. Added classes and instances for classes. Some changes to imrove overall+representation possibilities. 

@@ -1,5 +1,5 @@ {-# OPTIONS_HADDOCK show-extensions #-}-{-# OPTIONS_GHC -funbox-strict-fields #-}+{-# OPTIONS_GHC -funbox-strict-fields -fobject-code #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE UnboxedTuples #-}@@ -20,7 +20,8 @@  module Data.Phonetic.Languages.Base (   -- * Phonetics representation data type for the phonetic languages approach.-  PhoneticsRepresentationPL(..)+  PhoneticElement(..)+  , PhoneticsRepresentationPL(..)   , PhoneticsRepresentationPLX(..)   , Generations   , InterGenerationsString@@ -52,10 +53,11 @@   , compareG ) where -import Data.List (sortBy,groupBy,nub,(\\),find,partition)+import Data.List (sortBy,groupBy,nub,(\\),find,partition,intercalate) import GHC.Int (Int8(..)) import Data.Maybe (isJust,fromJust) import Data.Either+import Data.Char (isLetter) import GHC.Arr import GHC.Exts @@ -71,6 +73,34 @@   PREmpty { string :: String }     deriving (Eq, Ord) +instance Show PhoneticsRepresentationPL where+  show (PR xs ys zs) = intercalate " " ["R", show zs, show xs, show ys]+  show (PRAfter xs ys) = intercalate " " ["A", show xs, show ys]+  show (PRBefore xs zs) = intercalate " " ["B", show zs, show xs]+  show (PREmpty xs) = "E " `mappend` show xs++class PhoneticElement a where+  readPEMaybe :: String -> Maybe a++instance PhoneticElement PhoneticsRepresentationPL where+  readPEMaybe rs+    | not . any isLetter $ rs = Nothing+    | otherwise = case ys of+        "R" -> case yss of+           [zs,xs,ts] -> Just (PR xs ts zs)+           _ -> Nothing+        "A" -> case yss of+           [xs,ts] -> Just (PRAfter xs ts)+           _ -> Nothing+        "B" -> case yss of+           [zs,xs] -> Just (PRBefore xs zs)+           _ -> Nothing+        "E" -> case yss of+           [xs] -> Just (PREmpty xs)+           _ -> Nothing+        _ -> Nothing+       where (ys:yss) = words rs  + -- | Extended variant of the 'PhoneticsRepresentationPL' 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. @@ -79,6 +109,39 @@   PRBeforeC { stringX :: String, beforeStringX :: String, char :: Char } |   PREmptyC { stringX :: String, char :: Char }     deriving (Eq, Ord)++instance Show PhoneticsRepresentationPLX where+  show (PRC xs ys zs c) = intercalate " " ["RC", show zs, show xs, show ys, '\'':c:"\'"]+  show (PRAfterC xs ys c) = intercalate " " ["AC", show xs, show ys, '\'':c:"\'"]+  show (PRBeforeC xs zs c) = intercalate " " ["BC", show zs, show xs, '\'':c:"\'"]+  show (PREmptyC xs c) = "EC " `mappend` show xs `mappend` (' ':'\'':c:"\'")++instance PhoneticElement PhoneticsRepresentationPLX where+  readPEMaybe rs+    | not . any isLetter $ rs = Nothing+    | otherwise = case ys of+        "RC" -> case yss of+           [zs,xs,ts,cs] -> case cs of+               '\'':c:"\'" -> Just (PRC xs ts zs c)+               _ -> Nothing+           _ -> Nothing+        "AC" -> case yss of+           [xs,ts,cs] -> case cs of+               '\'':c:"\'" -> Just (PRAfterC xs ts c)+               _ -> Nothing+           _ -> Nothing+        "BC" -> case yss of+           [zs,xs,cs] -> case cs of+               '\'':c:"\'" -> Just (PRBeforeC xs zs c)+               _ -> Nothing+           _ -> Nothing+        "EC" -> case yss of+           [xs,cs] -> case cs of+               '\'':c:"\'" -> Just (PREmptyC xs c)+               _ -> Nothing+           _ -> Nothing+        _ -> Nothing+       where (ys:yss) = words rs      isPRC :: PhoneticsRepresentationPLX -> Bool isPRC (PRC _ _ _ _) = True

@@ -1,6 +1,7 @@ {-# OPTIONS_HADDOCK show-extensions #-} {-# OPTIONS_GHC -funbox-strict-fields -fobject-code #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE MagicHash #-} @@ -27,6 +28,7 @@   , SegmentationLineFunction(..)   , SegmentationRules1(..)   , SegmentRulesG+  , DListRepresentation(..)   -- * Basic functions   , str2PRSs   , sndGroups@@ -48,7 +50,7 @@  import Prelude hiding (mappend) import Data.Monoid-import qualified Data.List as L (groupBy,find)+import qualified Data.List as L (groupBy,find,intercalate) import Data.Phonetic.Languages.Base import CaseBi.Arr import GHC.Arr@@ -56,6 +58,8 @@ import Data.List.InnToOut.Basic (mapI) import Data.Maybe (mapMaybe,fromJust) import GHC.Int+import Text.Read (readMaybe)+import Data.Char (isLetter)  -- Inspired by: https://github.com/OleksandrZhabenko/mm1/releases/tag/0.2.0.0 @@ -72,8 +76,14 @@       EQ -> compare y1 y2       ~z -> z +instance Show PRS where+  show (SylS c (P x)) = "SylS \'" `mappend` (c:'\'':' ':show x)+ data PhoneticType = P !Int8 deriving (Eq, Ord) +instance Show PhoneticType where+  show (P x) = "P " `mappend` show x+ {-| The 'Array' 'Int' must be sorted in the ascending order to be used in the module correctly. -} type CharPhoneticClassification = Array Int PRS@@ -168,13 +178,40 @@  predicateN :: Int8 -- ^ Number of predicates in the definition for the 'fieldN' that are needed to apply the segmentation rules. } deriving (Eq) +instance Show SegmentationInfo1 where+  show (SI m n) = L.intercalate " " ["SI", show m, show n]++instance PhoneticElement SegmentationInfo1 where+  readPEMaybe rs+    | not . any isLetter $ rs = Nothing+    | otherwise = let (ys:yss) = words rs in case ys of+        "SI" -> case yss of+           [xs,ts] -> case (readMaybe xs::Maybe Int8) of+               Just m -> case (readMaybe ts::Maybe Int8) of+                 Just n -> Just (SI m n)+                 _ -> Nothing+               _ -> Nothing+           _ -> Nothing+        _ -> Nothing+ data SegmentationPredFunction = PF (SegmentationInfo1 -> [(Char, Char)] -> [PRS] -> Bool)  type DListFunctionResult = ([PRS] -> [PRS],[PRS] -> [PRS]) +class DListRepresentation a b where+  toDLR :: b -> [a] -> ([a] -> [a], [a] -> [a])++instance DListRepresentation PRS Int8 where+  toDLR left xs+    | null xs = (id,id)+    | null ts =  (id,(zs `mappend`))+    | null zs = ((`mappend` ts), id)+    | otherwise = ((`mappend` ts), (zs `mappend`))+        where (ts,zs) = splitAt (fromEnum left) xs+            data SegmentationLineFunction = LFS {   predF :: SegmentationPredFunction,  -- ^ The predicate to check the needed rule for segmentation.-  resF :: DListFunctionResult -- ^ The result if the 'predF' returns 'True' for its arguments.+  resF :: Int8 -- ^ The result argument to be appended to the left of the group of consonants if the 'predF' returns 'True' for its arguments. Is an argument to the 'toDLR'. }  data SegmentationRules1 = SR1 {@@ -194,9 +231,9 @@ -- https://msn.khnu.km.ua/pluginfile.php/302375/mod_resource/content/1/%D0%9B.3.%D0%86%D0%86.%20%D0%A1%D0%BA%D0%BB%D0%B0%D0%B4.%D0%9D%D0%B0%D0%B3%D0%BE%D0%BB%D0%BE%D1%81.pdf -- The example of the 'divCnsnts' can be found at: https://hackage.haskell.org/package/ukrainian-phonetics-basic-array-0.1.2.0/docs/src/Languages.Phonetic.Ukrainian.Syllable.Arr.html#divCnsnts divCnsnts :: [(Char,Char)] -> SegmentRulesG -> [PRS] -> DListFunctionResult-divCnsnts ks gs xs@(_:_) = resF . fromJust . L.find ((\(PF f) -> f (infoS js) ks xs) . predF). lineFs $ js-  where !l = length xs-        !js = fromJust . L.find ((== l) . fromEnum . fieldN . infoS) $ gs -- js :: SegmentationRules1+divCnsnts ks gs xs@(_:_) = toDLR left xs+  where !js = fromJust . L.find ((== length xs) . fromEnum . fieldN . infoS) $ gs -- js :: SegmentationRules1+        !left = resF . fromJust . L.find ((\(PF f) -> f (infoS js) ks xs) . predF). lineFs $ js divCnsnts _ _ [] = (id,id)  reSyllableCntnts :: [(Char,Char)] -> SegmentRulesG -> [[PRS]] -> [[PRS]]

@@ -3,7 +3,7 @@ -- http://haskell.org/cabal/users-guide/  name:                phonetic-languages-phonetics-basics-version:             0.3.2.0+version:             0.3.3.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@@ -20,7 +20,7 @@ library   exposed-modules:     Data.Phonetic.Languages.Undefined, Data.Phonetic.Languages.Base, Data.Phonetic.Languages.Syllables   -- other-modules:-  other-extensions:    CPP, BangPatterns, UnboxedTuples, MagicHash+  other-extensions:    CPP, BangPatterns, UnboxedTuples, MagicHash, MultiParamTypeClasses   ghc-options:         -funbox-strict-fields -fobject-code   build-depends:       base >=4.8 && <4.15, mmsyn2-array >= 0.1.3 && <1, mmsyn5 >= 0.5 && <1   -- hs-source-dirs: