diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -50,3 +50,8 @@ * Fifth version revised A. Updated the dependencies to use the new functionality. +## 0.6.0.0 -- 2023-03-05 + +* Sixth version. Switched to NoImplicitPrelude extension. Updated the dependencies boundaries to +support the new functionality. + diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2021-2022 Oleksandr Zhabenko +Copyright (c) 2021-2023 Oleksandr Zhabenko Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the diff --git a/Phladiprelio/General/CommonE.hs b/Phladiprelio/General/CommonE.hs new file mode 100644 --- /dev/null +++ b/Phladiprelio/General/CommonE.hs @@ -0,0 +1,102 @@ +{-# OPTIONS_GHC -threaded -rtsopts #-} +{-# OPTIONS_HADDOCK show-extensions #-} +{-# LANGUAGE BangPatterns, FlexibleContexts, NoImplicitPrelude #-} + +-- | +-- Module : Phladiprelio.General.CommonE +-- Copyright : (c) Oleksandr Zhabenko 2020-2023 +-- License : MIT +-- Stability : Experimental +-- Maintainer : oleksandr.zhabenko@yahoo.com +-- +-- Is rewritten from the module Phladiprelio.Ukrainian.CommonE from the package @phonetic-languages-simplified-examples-common@. +-- + +module Phladiprelio.General.CommonE ( + fLinesN + , fLines + , fLinesNIO + , fLinesIO +) where + +import GHC.Base hiding (foldr,length) +import GHC.List hiding (foldr,length) +import System.IO (putStrLn) +import GHC.Num ((+),(-),(*)) +import Text.Show (show) +import Data.Foldable (Foldable,foldr,length) +import Phladiprelio.General.PrepareText +import Data.Char (isAlpha) + +fLinesN + :: Int + -> Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to + -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. + -> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to + -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. + -> String + -> String + -> String + -> Int + -> String + -> [String] +fLinesN n ysss zsss xs us vs !toOneLine ys = filter (any (\x -> isPLL xs x && isAlpha x)) . prepareTextN n ysss zsss xs . + (\z -> if toOneLine == 1 then unls z else z) $ ys + -- the 'unls' is taken from the 'Data.List.words' and rewritten to be equal to 'unwords' . 'words' + where unls s = case dropWhile (`elem` (' ':us `mappend` vs)) s of + "" -> [] + s' -> w `mappend` (' ' : unls s'') + where (w, s'') = break (`elem` (' ':us `mappend` vs)) s' + +fLines + :: Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to + -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. + -> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to + -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. + -> String + -> String + -> String + -> Int + -> String + -> [String] +fLines = fLinesN 7 +{-# INLINE fLines #-} + +fLinesNIO + :: Int + -> Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to + -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. + -> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to + -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. + -> String + -> String + -> String + -> String + -> IO () +fLinesNIO n ysss zsss xs us vs ys = mapM putStrLn (map (\(i,x) -> show (i + 1) ++ "\t" ++ x) . helpG3 . indexedL "" . + filter (any (\x -> isPLL xs x && isAlpha x)) . prepareTextN n ysss zsss xs $ ys) >> pure () + +fLinesIO + :: Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to + -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. + -> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to + -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. + -> String + -> String + -> String + -> String + -> IO () +fLinesIO = fLinesNIO 7 +{-# INLINE fLinesIO #-} + +-- | Indexes the 'Foldable' structure using consequential 'Int' values. +indexedL :: Foldable t => b -> t b -> [(Int, b)] +indexedL y zs = foldr f v zs + where !v = [(length zs,y)] + f x ((j,z):ys) = (j-1,x):(j,z):ys +{-# INLINE indexedL #-} + +helpG3 :: [a] -> [a] +helpG3 xs + | null xs = [] + | otherwise = init xs diff --git a/Phladiprelio/General/DeEnCoding.hs b/Phladiprelio/General/DeEnCoding.hs new file mode 100644 --- /dev/null +++ b/Phladiprelio/General/DeEnCoding.hs @@ -0,0 +1,177 @@ +{-# OPTIONS_GHC -threaded -rtsopts #-} +{-# OPTIONS_HADDOCK show-extensions #-} +{-# LANGUAGE BangPatterns, NoImplicitPrelude #-} + +-- | +-- Module : Phladiprelio.General.DeEnCoding +-- Copyright : (c) Oleksandr Zhabenko 2020-2023 +-- License : MIT +-- Stability : Experimental +-- Maintainer : oleksandr.zhabenko@yahoo.com +-- +-- Functions to encode and decode 'String' -> \['Int8'\] used in the Simple/Main.hs code. +-- Firstly were taken from the @phonetic-languages-simplified-lists-examples@ package. +-- Is modified from the module Phladiprelio.Simplified.DeEnCoding from the +-- @phonetic-languages-simplified-examples-common@ package. + +module Phladiprelio.General.DeEnCoding where + +import GHC.Base hiding (foldr) +import GHC.Num ((+),(-),(*)) +import GHC.List (head,zip,init) +import GHC.Enum (fromEnum,toEnum) +import qualified Data.Heap as Heap +import GHC.Int +import Data.Foldable +import Data.Tuple (fst,snd) +import Data.List (sortOn,sort,partition,words,unwords) +import System.IO (putStrLn,Newline(LF),nativeNewline) +import Data.Maybe (fromJust) +import Numeric +import Phladiprelio.General.EmphasisG +import Phladiprelio.General.Base +import Phladiprelio.General.Syllables + +--default (Int, Double) + +encodeToInt :: Ord a => [[a]] -> Int +encodeToInt yss + | null ks = -1 + | otherwise = fst . head $ ks + where ks = readHex (showHex (foldl' (\x y -> x * 16 + y) 0 . map (\(j,_) -> fromEnum j) . sortOn snd . trans2 $ yss) $ "") +{-# INLINABLE encodeToInt #-} + + +-- | Is taken mostly from the Phladiprelio.Simplified.Lists.UniquenessPeriodsG module from the @phonetic-languages-simplified-common@ package. +indexedL :: Foldable t => b -> t b -> [(Int8, b)] +indexedL y zs = foldr f v zs + where !v = [(toEnum (length zs + 1),y)] + f x ((j,z):ys) = (j-1,x):(j,z):ys +{-# INLINE indexedL #-} + +trans2 :: [[a]] -> [(Int8, [a])] +trans2 = init . indexedL [] +{-# INLINE trans2 #-} + +trans232 :: [[a]] -> [(Int, [a])] +trans232 zs = init . foldr f v $ zs + where !v = [(length zs + 1,[])] + f x ((j,z):ys) = (j-1,x):(j,z):ys +{-# INLINE trans232 #-} + +int2l :: Int -> [Int8] +int2l n + | n < 16 = [toEnum n] + | otherwise = int2l n1 `mappend` [l] + where (!n1,!l0) = quotRemInt n 16 + !l = toEnum l0 +{-# INLINABLE int2l #-} + +-- | So for the strings consisting of no more than 10 words: +-- > decodeToStr (int2l . encodeToInt . words $ xs) xs == unwords . words $ xs +-- +decodeToStr :: [Int8] -> String -> String +decodeToStr ys = unwords . map snd . sortOn fst . zip ys . sort . words +{-# INLINE decodeToStr #-} + +-- | For the 'ReadyForConstructionUkr' that corresponds to the 'String' consisting of no more than 10 words. +-- +decodeToReadyFCPL :: [Int8] -> ReadyForConstructionPL -> ReadyForConstructionPL +decodeToReadyFCPL ys (StrG ts) = StrG . unwords . map snd . sortOn fst . zip ys . sort . words $ ts +decodeToReadyFCPL ys (FSLG tsss) = FSLG . map snd . sortOn fst . zip ys . sort $ tsss +{-# INLINE decodeToReadyFCPL #-} + +-- | Every 'String' consists of words with whitespace symbols in between. +toHeap :: [String] -> Heap.Heap Int +toHeap yss@(xs:xss) + | null xss = Heap.singleton . encodeToInt . words $ xs + | otherwise = Heap.fromList . map (encodeToInt . words) $ yss +toHeap _ = Heap.empty +{-# INLINE toHeap #-} + +-- | Every 'ReadyForConstructionUkr' corresponds to the 'String' that consists of words with whitespace symbols in between. +-- The list must be consistent -- either 'FSL'-constructed or 'Str'-constructed. +toHeapR :: [ReadyForConstructionPL] -> Heap.Heap Int +toHeapR yss@(xs@(StrG ts):xss) + | null xss = Heap.singleton . encodeToInt . words $ ts + | otherwise = Heap.fromList . map (encodeToInt . words . fromJust . fromReadyFCPLS) $ yss +toHeapR yss@(xs@(FSLG tsss):xss) + | null xss = Heap.singleton . encodeToInt $ tsss + | otherwise = Heap.fromList . map (encodeToInt . fromJust . fromReadyFCPLF) $ yss +toHeapR _ = Heap.empty +{-# INLINE toHeapR #-} + +fromHeap:: String -> Heap.Heap Int -> [String] +fromHeap ys heap + | Heap.null heap = [] + | otherwise = map (flip decodeToStr ys . int2l) . Heap.toUnsortedList $ heap +{-# INLINE fromHeap #-} + +fromHeapReadyFCPL :: ReadyForConstructionPL -> Heap.Heap Int -> [ReadyForConstructionPL] +fromHeapReadyFCPL ys heap + | Heap.null heap = [] + | otherwise = map (flip decodeToReadyFCPL ys . int2l) . Heap.toUnsortedList $ heap +{-# INLINE fromHeapReadyFCPL #-} + +intersectInterResults :: [String] -> [String] -> [String] +intersectInterResults zss + | null zss = const [] + | otherwise = fromHeap (head zss) . Heap.intersect (toHeap zss) . toHeap +{-# INLINE intersectInterResults #-} + +-- | It is not well tested. Just as the whole module. +intersectInterReadyFCPL :: (String -> [[[Int8]]]) -> [ReadyForConstructionPL] -> [ReadyForConstructionPL] -> [ReadyForConstructionPL] +intersectInterReadyFCPL convF zss tss + | null zss = [] + | null tss = [] + | (isStr . head $ tss) && (isStr . head $ zss) = fromHeapReadyFCPL (head zss) . Heap.intersect (toHeapR zss) . toHeapR $ tss + | (isFSL . head $ tss) && (isFSL . head $ zss) = fromHeapReadyFCPL (head zss) . Heap.intersect (toHeapR zss) . toHeapR $ tss + | isStr . head $ tss = fromHeapReadyFCPL (head zss) . Heap.intersect (toHeapR zss) . toHeapR . map (FSLG . convF . fromJust . fromReadyFCPLS) $ tss + | otherwise = fromHeapReadyFCPL (head tss) . Heap.intersect (toHeapR . map (FSLG . convF . fromJust . fromReadyFCPLS) $ zss) . toHeapR $ tss +{-# INLINE intersectInterReadyFCPL #-} + +intersectInterReadyFCPL2 + :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text. + -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon + -- (e. g. allophones). Must be sorted in the ascending order to be used correctly. + -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly. + -> SegmentRulesG + -> String -- ^ Corresponds to the \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package. + -> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package. + -> String + -> [ReadyForConstructionPL] + -> [ReadyForConstructionPL] + -> [ReadyForConstructionPL] +intersectInterReadyFCPL2 wrs ks arr hs us vs ts = intersectInterReadyFCPL (convFI wrs ks arr hs us vs ts) +{-# INLINE intersectInterReadyFCPL2 #-} + +-- | Auxiliary printing function to define the line ending in some cases. Is taken from the +-- Languages.UniquenessPeriods.Vector.General.DebugG module from the @phonetic-languages-general@ package +newLineEnding :: String +newLineEnding + | nativeNewline == LF = "\n" + | otherwise = "\r\n" + + +foldlI + :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text. + -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon + -- (e. g. allophones). Must be sorted in the ascending order to be used correctly. + -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly. + -> SegmentRulesG + -> String -- ^ Corresponds to the \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package. + -> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package. + -> String + -> [[ReadyForConstructionPL]] + -> [ReadyForConstructionPL] +foldlI wrs ks arr hs us vs ts jss@((!xs):ys:xss) + | null pss = foldlI' wrs ks arr hs us vs ts qss + | null qss = foldlI' wrs ks arr hs us vs ts pss + | otherwise = intersectInterReadyFCPL2 wrs ks arr hs us vs ts (foldlI' wrs ks arr hs us vs ts pss) (foldlI' wrs ks arr hs us vs ts qss) + where (pss,qss) = partition (< [FSLG []]) jss + foldlI' wrs ks arr hs us vs ts rss@(rs:ps:yss) = foldlI' wrs ks arr hs us vs ts (intersectInterReadyFCPL2 wrs ks arr hs us vs ts rs ps : yss) + foldlI' wrs ks arr hs us vs ts ((!xs):_) = xs + foldlI' _ _ _ _ _ _ _ _ = [] +foldlI _ _ _ _ _ _ _ ((!xs):_) = xs +foldlI _ _ _ _ _ _ _ _ = [] + diff --git a/Phladiprelio/General/SimpleConstraints.hs b/Phladiprelio/General/SimpleConstraints.hs new file mode 100644 --- /dev/null +++ b/Phladiprelio/General/SimpleConstraints.hs @@ -0,0 +1,24 @@ +-- | +-- Module : Phladiprelio.General.SimpleConstraints +-- Copyright : (c) Oleksandr Zhabenko 2020-2023 +-- License : MIT +-- Stability : Experimental +-- Maintainer : oleksandr.zhabenko@yahoo.com +-- +-- Some code shared for different Main modules. +-- Is taken from the module Phladiprelio.Simplified.SimpleConstraints from the +-- @phonetic-languages-simplified-examples-common@ package. + +{-# LANGUAGE NoImplicitPrelude #-} + +module Phladiprelio.General.SimpleConstraints where + +import GHC.Base +import GHC.Num ((-)) +import GHC.List (concatMap) +import Text.Show (show) + +showB :: Int -> Bool -> String +showB n bool + | n >= 2 && bool == True = 'B':show (n - 1) `mappend` concatMap show [0..n - 2] + | otherwise = "" diff --git a/Phonetic/Languages/General/Common.hs b/Phonetic/Languages/General/Common.hs deleted file mode 100644 --- a/Phonetic/Languages/General/Common.hs +++ /dev/null @@ -1,97 +0,0 @@ -{-# OPTIONS_GHC -threaded -rtsopts #-} -{-# OPTIONS_HADDOCK show-extensions #-} -{-# LANGUAGE BangPatterns, FlexibleContexts #-} - --- | --- Module : Phonetic.Languages.General.Common --- Copyright : (c) OleksandrZhabenko 2020-2022 --- License : MIT --- Stability : Experimental --- Maintainer : olexandr543@yahoo.com --- --- Is rewritten from the module Phonetic.Languages.Common from the package @phonetic-languages-simplified-examples-common@. --- - -module Phonetic.Languages.General.Common ( - fLinesN - , fLines - , fLinesNIO - , fLinesIO -) where - -import Data.Phonetic.Languages.PrepareText -import Data.Char (isAlpha) -import Data.Monoid (mappend) - -fLinesN - :: Int - -> Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to - -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. - -> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to - -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. - -> String - -> String - -> String - -> Int - -> String - -> [String] -fLinesN n ysss zsss xs us vs !toOneLine ys = filter (any (\x -> isPLL xs x && isAlpha x)) . prepareTextN n ysss zsss xs . - (\z -> if toOneLine == 1 then unls z else z) $ ys - -- the 'unls' is taken from the 'Data.List.words' and rewritten to be equal to 'unwords' . 'words' - where unls s = case dropWhile (`elem` (' ':us `mappend` vs)) s of - "" -> [] - s' -> w `mappend` (' ' : unls s'') - where (w, s'') = break (`elem` (' ':us `mappend` vs)) s' - -fLines - :: Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to - -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. - -> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to - -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. - -> String - -> String - -> String - -> Int - -> String - -> [String] -fLines = fLinesN 7 -{-# INLINE fLines #-} - -fLinesNIO - :: Int - -> Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to - -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. - -> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to - -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. - -> String - -> String - -> String - -> String - -> IO () -fLinesNIO n ysss zsss xs us vs ys = mapM_ putStrLn . map (\(i,x) -> show (i + 1) ++ "\t" ++ x) . helpG3 . indexedL "" . - filter (any (\x -> isPLL xs x && isAlpha x)) . prepareTextN n ysss zsss xs $ ys - -fLinesIO - :: Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to - -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. - -> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to - -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to. - -> String - -> String - -> String - -> String - -> IO () -fLinesIO = fLinesNIO 7 -{-# INLINE fLinesIO #-} - --- | Indexes the 'Foldable' structure using consequential 'Int' values. -indexedL :: Foldable t => b -> t b -> [(Int, b)] -indexedL y zs = foldr f v zs - where !v = [(length zs,y)] - f x ((j,z):ys) = (j-1,x):(j,z):ys -{-# INLINE indexedL #-} - -helpG3 :: [a] -> [a] -helpG3 xs - | null xs = [] - | otherwise = init xs diff --git a/Phonetic/Languages/General/DeEnCoding.hs b/Phonetic/Languages/General/DeEnCoding.hs deleted file mode 100644 --- a/Phonetic/Languages/General/DeEnCoding.hs +++ /dev/null @@ -1,174 +0,0 @@ -{-# OPTIONS_GHC -threaded -rtsopts #-} -{-# OPTIONS_HADDOCK show-extensions #-} -{-# LANGUAGE BangPatterns #-} - --- | --- Module : Phonetic.Languages.General.DeEnCoding --- Copyright : (c) OleksandrZhabenko 2020-2022 --- License : MIT --- Stability : Experimental --- Maintainer : olexandr543@yahoo.com --- --- Functions to encode and decode 'String' -> \['Int8'\] used in the Simple/Main.hs code. --- Firstly were taken from the @phonetic-languages-simplified-lists-examples@ package. --- Is modified from the module Phonetic.Languages.Simplified.DeEnCoding from the --- @phonetic-languages-simplified-examples-common@ package. - -module Phonetic.Languages.General.DeEnCoding where - -import Data.Heap (Heap) -import qualified Data.Heap as Heap -import GHC.Int -import Data.Foldable (foldl') -import Data.List (sortBy,sort,partition) -import System.IO -import Data.Maybe (fromJust) -import Numeric -import Phonetic.Languages.EmphasisG -import Data.Phonetic.Languages.Base -import Data.Phonetic.Languages.Syllables ---import Phonetic.Languages.Coeffs - ---default (Int, Double) - -encodeToInt :: Ord a => [[a]] -> Int -encodeToInt yss - | null ks = -1 - | otherwise = fst . head $ ks - where ks = readHex (showHex (foldl' (\x y -> x * 16 + y) 0 . map (\(j,_) -> fromEnum j) . sortBy (\x y -> compare (snd x) (snd y)) . trans2 $ yss) $ "") -{-# INLINABLE encodeToInt #-} - - --- | Is taken mostly from the Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG module from the @phonetic-languages-simplified-common@ package. -indexedL :: Foldable t => b -> t b -> [(Int8, b)] -indexedL y zs = foldr f v zs - where !v = [(toEnum (length zs + 1),y)] - f x ((j,z):ys) = (j-1,x):(j,z):ys -{-# INLINE indexedL #-} - -trans2 :: [[a]] -> [(Int8, [a])] -trans2 = init . indexedL [] -{-# INLINE trans2 #-} - -trans232 :: [[a]] -> [(Int, [a])] -trans232 zs = init . foldr f v $ zs - where !v = [(length zs + 1,[])] - f x ((j,z):ys) = (j-1,x):(j,z):ys -{-# INLINE trans232 #-} - -int2l :: Int -> [Int8] -int2l n - | n < 16 = [toEnum n] - | otherwise = int2l n1 `mappend` [l] - where (!n1,!l0) = quotRem n 16 - !l = toEnum l0 -{-# INLINABLE int2l #-} - --- | So for the strings consisting of no more than 10 words: --- > decodeToStr (int2l . encodeToInt . words $ xs) xs == unwords . words $ xs --- -decodeToStr :: [Int8] -> String -> String -decodeToStr ys = unwords . map snd . sortBy (\x y -> compare (fst x) (fst y)) . zip ys . sort . words -{-# INLINE decodeToStr #-} - --- | For the 'ReadyForConstructionUkr' that corresponds to the 'String' consisting of no more than 10 words. --- -decodeToReadyFCPL :: [Int8] -> ReadyForConstructionPL -> ReadyForConstructionPL -decodeToReadyFCPL ys (StrG ts) = StrG . unwords . map snd . sortBy (\x y -> compare (fst x) (fst y)) . zip ys . sort . words $ ts -decodeToReadyFCPL ys (FSLG tsss) = FSLG . map snd . sortBy (\x y -> compare (fst x) (fst y)) . zip ys . sort $ tsss -{-# INLINE decodeToReadyFCPL #-} - --- | Every 'String' consists of words with whitespace symbols in between. -toHeap :: [String] -> Heap Int -toHeap yss@(xs:xss) - | null xss = Heap.singleton . encodeToInt . words $ xs - | otherwise = Heap.fromList . map (encodeToInt . words) $ yss -toHeap _ = Heap.empty -{-# INLINE toHeap #-} - --- | Every 'ReadyForConstructionUkr' corresponds to the 'String' that consists of words with whitespace symbols in between. --- The list must be consistent -- either 'FSL'-constructed or 'Str'-constructed. -toHeapR :: [ReadyForConstructionPL] -> Heap Int -toHeapR yss@(xs@(StrG ts):xss) - | null xss = Heap.singleton . encodeToInt . words $ ts - | otherwise = Heap.fromList . map (encodeToInt . words . fromJust . fromReadyFCPLS) $ yss -toHeapR yss@(xs@(FSLG tsss):xss) - | null xss = Heap.singleton . encodeToInt $ tsss - | otherwise = Heap.fromList . map (encodeToInt . fromJust . fromReadyFCPLF) $ yss -toHeapR _ = Heap.empty -{-# INLINE toHeapR #-} - -fromHeap :: String -> Heap Int -> [String] -fromHeap ys heap - | Heap.null heap = [] - | otherwise = map (flip decodeToStr ys . int2l) . Heap.toUnsortedList $ heap -{-# INLINE fromHeap #-} - -fromHeapReadyFCPL :: ReadyForConstructionPL -> Heap Int -> [ReadyForConstructionPL] -fromHeapReadyFCPL ys heap - | Heap.null heap = [] - | otherwise = map (flip decodeToReadyFCPL ys . int2l) . Heap.toUnsortedList $ heap -{-# INLINE fromHeapReadyFCPL #-} - -intersectInterResults :: [String] -> [String] -> [String] -intersectInterResults zss - | null zss = const [] - | otherwise = fromHeap (head zss) . Heap.intersect (toHeap zss) . toHeap -{-# INLINE intersectInterResults #-} - --- | It seems like it works, but it isn't. (??). The main reason is the hardness with defining convF to work properly. -intersectInterReadyFCPL :: (String -> [[[Int8]]]) -> [ReadyForConstructionPL] -> [ReadyForConstructionPL] -> [ReadyForConstructionPL] -intersectInterReadyFCPL convF zss tss - | null zss = [] - | null tss = [] - | (isStr . head $ tss) && (isStr . head $ zss) = fromHeapReadyFCPL (head zss) . Heap.intersect (toHeapR zss) . toHeapR $ tss - | (isFSL . head $ tss) && (isFSL . head $ zss) = fromHeapReadyFCPL (head zss) . Heap.intersect (toHeapR zss) . toHeapR $ tss - | isStr . head $ tss = fromHeapReadyFCPL (head zss) . Heap.intersect (toHeapR zss) . toHeapR . map (FSLG . convF . fromJust . fromReadyFCPLS) $ tss - | otherwise = fromHeapReadyFCPL (head tss) . Heap.intersect (toHeapR . map (FSLG . convF . fromJust . fromReadyFCPLS) $ zss) . toHeapR $ tss -{-# INLINE intersectInterReadyFCPL #-} - -intersectInterReadyFCPL2 - :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text. - -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon - -- (e. g. allophones). Must be sorted in the ascending order to be used correctly. - -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly. - -> SegmentRulesG - -> String -- ^ Corresponds to the \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package. - -> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package. - -> String - -> [ReadyForConstructionPL] - -> [ReadyForConstructionPL] - -> [ReadyForConstructionPL] -intersectInterReadyFCPL2 wrs ks arr hs us vs ts = intersectInterReadyFCPL (convFI wrs ks arr hs us vs ts) -{-# INLINE intersectInterReadyFCPL2 #-} - --- | Auxiliary printing function to define the line ending in some cases. Is taken from the --- Languages.UniquenessPeriods.Vector.General.DebugG module from the @phonetic-languages-general@ package -newLineEnding :: String -newLineEnding - | nativeNewline == LF = "\n" - | otherwise = "\r\n" - - -foldlI - :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text. - -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon - -- (e. g. allophones). Must be sorted in the ascending order to be used correctly. - -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly. - -> SegmentRulesG - -> String -- ^ Corresponds to the \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package. - -> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package. - -> String - -> [[ReadyForConstructionPL]] - -> [ReadyForConstructionPL] -foldlI wrs ks arr hs us vs ts jss@((!xs):ys:xss) - | null pss = foldlI' wrs ks arr hs us vs ts qss - | null qss = foldlI' wrs ks arr hs us vs ts pss - | otherwise = intersectInterReadyFCPL2 wrs ks arr hs us vs ts (foldlI' wrs ks arr hs us vs ts pss) (foldlI' wrs ks arr hs us vs ts qss) - where (pss,qss) = partition (< [FSLG []]) jss - foldlI' wrs ks arr hs us vs ts rss@(rs:ps:yss) = foldlI' wrs ks arr hs us vs ts (intersectInterReadyFCPL2 wrs ks arr hs us vs ts rs ps : yss) - foldlI' wrs ks arr hs us vs ts ((!xs):_) = xs - foldlI' _ _ _ _ _ _ _ _ = [] -foldlI _ _ _ _ _ _ _ ((!xs):_) = xs -foldlI _ _ _ _ _ _ _ _ = [] - diff --git a/Phonetic/Languages/General/SimpleConstraints.hs b/Phonetic/Languages/General/SimpleConstraints.hs deleted file mode 100644 --- a/Phonetic/Languages/General/SimpleConstraints.hs +++ /dev/null @@ -1,19 +0,0 @@ --- | --- Module : Phonetic.Languages.General.SimpleConstraints --- Copyright : (c) OleksandrZhabenko 2020-2021 --- License : MIT --- Stability : Experimental --- Maintainer : olexandr543@yahoo.com --- --- Some code shared for different Main modules. --- Is taken from the module Phonetic.Languages.Simplified.SimpleConstraints from the --- @phonetic-languages-simplified-examples-common@ package. - -module Phonetic.Languages.General.SimpleConstraints where - -import Data.Monoid - -showB :: Int -> Bool -> String -showB n bool - | n >= 2 && bool == True = 'B':show (n - 1) `mappend` concatMap show [0..n - 2] - | otherwise = "" diff --git a/phonetic-languages-simplified-generalized-examples-common.cabal b/phonetic-languages-simplified-generalized-examples-common.cabal --- a/phonetic-languages-simplified-generalized-examples-common.cabal +++ b/phonetic-languages-simplified-generalized-examples-common.cabal @@ -3,24 +3,24 @@ -- http://haskell.org/cabal/users-guide/ name: phonetic-languages-simplified-generalized-examples-common -version: 0.5.1.0 +version: 0.6.0.0 synopsis: Some common code for phonetic languages generalized functionality. description: Is intended to be used in the phonetic-languages-simplified-generalized-examples-array package. homepage: https://hackage.haskell.org/package/phonetic-languages-simplified-generalized-examples-common license: MIT license-file: LICENSE author: Oleksandr Zhabenko -maintainer: olexandr543@yahoo.com -copyright: Oleksandr Zhabenko 2020-2022 +maintainer: oleksandr.zhabenko@yahoo.com +copyright: Oleksandr Zhabenko 2020-2023 category: Language, Math, Game build-type: Simple extra-source-files: ChangeLog.md cabal-version: >=1.10 library - exposed-modules: Phonetic.Languages.General.SimpleConstraints, Phonetic.Languages.General.Common, Phonetic.Languages.General.DeEnCoding + exposed-modules: Phladiprelio.General.SimpleConstraints, Phladiprelio.General.CommonE, Phladiprelio.General.DeEnCoding -- other-modules: - other-extensions: BangPatterns, FlexibleContexts - build-depends: base >=4.8 && <5, phonetic-languages-phonetics-basics ==0.9.1.0, phonetic-languages-simplified-generalized-properties-array ==0.12.0.0, heaps >=0.3.6.1 && <1 + other-extensions: BangPatterns, FlexibleContexts, NoImplicitPrelude + build-depends: base >=4.13 && <5, phonetic-languages-phonetics-basics ==0.10.0.2, phonetic-languages-simplified-generalized-properties-array ==0.13.0.0, heaps >=0.3.6.1 && <1 -- hs-source-dirs: default-language: Haskell2010