packages feed

phonetic-languages-simplified-examples-common-0.6.0.0: Phladiprelio/Ukrainian/Common.hs

{-# OPTIONS_GHC -threaded -rtsopts #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns, FlexibleContexts, NoImplicitPrelude #-}

-- |
-- Module      :  Phladiprelio.Ukrainian.Common
-- Copyright   :  (c) Oleksandr Zhabenko 2020-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Some functions to provide show and print functionality for PhLADiPreLiO for Ukrainian language.
--

module Phladiprelio.Ukrainian.Common (
  fLinesN
  , fLines
  , fLinesNIO
  , fLinesIO
) where

import GHC.Base hiding (foldr)
import GHC.List (filter, break, dropWhile, init)
import Phladiprelio.Ukrainian.PrepareText
import Data.Char (isAlpha,isSpace)
import Data.Monoid (mappend)
import Data.Foldable (Foldable (..), any)
import GHC.Num ((+),(-))
import Text.Show (show)
import System.IO (putStrLn)

fLinesN :: Int -> Int -> String -> [String]
fLinesN n !toOneLine ys = filter (any (\x -> isUkrainianL x && isAlpha x)) . prepareTextN n .
  (\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 isSpace s of
                      "" -> []
                      s' -> w `mappend` (' ' : unls s'')
                        where (w, s'') = break isSpace s'

fLines :: Int -> String -> [String]
fLines = fLinesN 7
{-# INLINE fLines #-}

fLinesNIO :: Int -> String -> IO ()
fLinesNIO n ys = mapM putStrLn (map (\(i,x) -> show (i + 1) `mappend` "\t" `mappend` x) . helpG3 . indexedL "" .
   filter (any (\x -> isUkrainianL x && isAlpha x)) . prepareTextN n $ ys) >> return ()

fLinesIO :: String -> IO ()
fLinesIO = fLinesNIO 7
{-# INLINE fLinesIO #-}

-- | Is taken mostly from the Phonetic.Languages.Ukrainian.Simplified.Lists.UniquenessPeriodsG module from the @phonetic-languages-simplified-common@ package.
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