packages feed

phladiprelio-ukrainian-simple-0.8.0.0: Phladiprelio/Ukrainian/IO.hs

{-# LANGUAGE NoImplicitPrelude, BangPatterns #-}

module Phladiprelio.Ukrainian.IO where

import GHC.Base
import GHC.Num (Integer,(+),(-),(*))
import GHC.Real (fromIntegral,(/),quot,rem,quotRem)
import GHC.Enum (fromEnum,toEnum)
import Text.Show (Show(..))
import Text.Read (readMaybe)
import Data.Char (isDigit)
import System.IO (putStrLn, FilePath,stdout,hSetNewlineMode,universalNewlineMode,getLine,appendFile)
import Rhythmicity.MarkerSeqs hiding (id) 
import Data.List hiding (foldr)
import Data.Maybe (isNothing,fromJust) 
import Data.Tuple (fst)
import Phladiprelio.Ukrainian.Syllable 
import Phladiprelio.Ukrainian.SyllableDouble
import Phladiprelio.Ukrainian.Melodics 
import GHC.Int (Int8)
import Phladiprelio.Ukrainian.ReadDurations
import Data.Ord (comparing)
import Numeric (showFFloat)
import Phladiprelio.Halfsplit
import System.Directory (readable,writable,getPermissions,Permissions(..))
import Data.ReversedScientific

generalF :: FilePath -> Int -> HashCorrections -> (Int8,[Int8]) -> Int -> Bool -> Int -> Bool -> Int8 -> (FilePath, Int) -> [String] -> IO [String]
generalF file numTest hc (grps,mxms) k descending hashStep emptyline splitting (fs,code) universalSet@(u1:u2:us) = do
   syllableDurationsDs <- readSyllableDurations file
   let syllN = countSyll . concat . take 1 $ universalSet
--       universalSet = map unwords . permutations . words $ rs
       f syllableDurationsDs grps mxms = sum . countHashes2G hashStep hc grps mxms . mconcat . 
                (if null file then case k of { 1 -> syllableDurationsD; 2 -> syllableDurationsD2; 3 -> syllableDurationsD3; 4 -> syllableDurationsD4} 
                         else  if length syllableDurationsDs >= k then syllableDurationsDs !! (k - 1) else syllableDurationsD2) . createSyllablesUkrS
   hSetNewlineMode stdout universalNewlineMode
   if numTest >= 0 && numTest <= 179 && numTest /= 1 then do
     putStrLn "Feet   Val  Stat   Proxim" 
     mapM (\(q,qs) -> let m = stat1 syllN (q,qs)
                          (min1, max1) = minMax11ByCList (comparing (f syllableDurationsDs q qs)) universalSet 
                          mx = f syllableDurationsDs q qs max1 
                          strTest = (show (fromEnum q) `mappend` "   |   " `mappend`  show mx `mappend` "     " `mappend` show m `mappend` "  -> " `mappend` 
                             showFFloat (Just 3) (100 * fromIntegral mx / fromIntegral m) "%" `mappend` (if rem numTest 10 >= 4 
                                                                                                             then ("\n" `mappend` min1 `mappend` "\n" `mappend` max1 `mappend` "\n")
                                                                                                             else "")) in putStrLn strTest >> return strTest) . zip (sel2 numTest) $ (sel numTest)
   else let sRepresent = zipWith (\k (x, ys) -> S k x ys) [1..] . 
                   (let h1 = if descending then (\(u,w) -> ((-1) * u, w)) else id in sortOn h1) . map (\xss -> (f syllableDurationsDs grps mxms xss, xss)) $ universalSet
            strOutput = (:[]) . halfsplit (\(S _ y _) -> y) (jjj splitting) $ sRepresent
                        in do
                             _ <- mapM putStrLn strOutput
                             let l1 = length sRepresent
                             if code == -1 
                                 then return strOutput
                                 else parseLineNumber l1 >>= \num -> do
                                         permiss <- getPermissions fs
                                         let writ = writable permiss
                                             readab = readable permiss
                                         if writ && readab then appendFile fs (flip outputSel code . head . filter (\(S k _ _) -> k == num) $ sRepresent)
                                         else error "The specified file cannot be used for appending the text! Please, specify another file!"
                                         return []
     where sel x 
              | x == 1 || x < 0 || x > 179 = []
              | x == 0 || x == 4 = [[1],[2,1],[3,2],[4,3,2],[5,4,3],[6,5,4,3,2]]  -- all cases are present: 2, 3, 4, 5, 6, 7. Therefore, the slowest ones.
              | x == 2 || x == 5 = [[1],[2],[3],[4,3],[5,4],[6,5,4]]
              | x == 7 = [[0],[1,0],[1,0],[1,0],[1,0],[1,0]]
              | x == 8 = [[0],[1,0],[1,0],[2,1,0],[2,1,0],[2,1,0]]
              | x == 9 = [[0],[1,0],[1,0],[2,1,0],[3,2,1,0],[3,2,1,0]]
-----------------------------------------------------------------------------
              | x >= 20 && x <= 26 && x /= 21 = [[1]]  -- at least 7 is omitted, but probably 6, or even 5, or even 4, or even 3. 2 is however present.
              | x >= 27 && x <= 29 = [[0]]
              | x == 30 || x == 34 = [[1],[2,1]]
              | x == 32 || x == 35 = [[1],[2]]
              | x >= 37 && x <= 39 = [[0],[1,0]]
              | x == 40 || x == 44 = [[1],[2,1],[3,2]]
              | x == 42 || x == 45 = [[1],[2],[3]]
              | x >= 47 && x <= 49 = [[0],[1,0],[1,0]]
              | x == 50 || x == 54 = [[1],[2,1],[3,2],[4,3,2]]
              | x == 52 || x == 55 = [[1],[2],[3],[4,3]]
              | x == 57 = [[0],[1,0],[1,0],[1,0]]
              | x == 58 || x == 59 = [[0],[1,0],[1,0],[2,1,0]]
              | x == 60 || x == 64 = [[1],[2,1],[3,2],[4,3,2],[5,4,3]]
              | x == 62 || x == 65 = [[1],[2],[3],[4,3],[5,4]]
              | x == 67 = [[0],[1,0],[1,0],[1,0],[1,0]]
              | x == 68 = [[0],[1,0],[1,0],[2,1,0],[2,1,0]]
              | x == 69 = [[0],[1,0],[1,0],[2,1,0],[3,2,1,0]]
-----------------------------------------------------------------
              | x == 70 || x == 74 = [[2,1],[3,2],[4,3,2],[5,4,3],[6,5,4,3,2]]  -- at least 2 is omitted, but probably 3 and even 4. 5, 6 and 7 are present.
              | x == 72 || x == 75 = [[2],[3],[4,3],[5,4],[6,5,4]]
              | x == 77 = [[1,0],[1,0],[1,0],[1,0],[1,0]]
              | x == 78 = [[1,0],[1,0],[2,1,0],[2,1,0],[2,1,0]]
              | x == 79 = [[1,0],[1,0],[2,1,0],[3,2,1,0],[3,2,1,0]]
              | x == 80 || x == 84 = [[3,2],[4,3,2],[5,4,3],[6,5,4,3,2]]
              | x == 82 || x == 85 = [[3],[4,3],[5,4],[6,5,4]]
              | x == 87 = [[1,0],[1,0],[1,0],[1,0]]
              | x == 88 = [[1,0],[2,1,0],[2,1,0],[2,1,0]]
              | x == 89 = [[1,0],[2,1,0],[3,2,1,0],[3,2,1,0]]
              | x == 90 || x == 94 = [[4,3,2],[5,4,3],[6,5,4,3,2]]
              | x == 92 || x == 95 = [[4,3],[5,4],[6,5,4]]
              | x == 97 = [[1,0],[1,0],[1,0]]
              | x == 98 = [[2,1,0],[2,1,0],[2,1,0]]
              | x == 99 = [[2,1,0],[3,2,1,0],[3,2,1,0]]
-----------------------------------------------------------------------------------
              | x == 100 || x == 104 = [[1],[2,1],[4,3,2],[6,5,4,3,2]]  -- 4 and 6 are omitted, just present the ones from: 2, 3, 5, 7.
              | x == 102 || x == 105 = [[1],[2],[4,3],[6,5,4]]
              | x == 107 = [[0],[1,0],[1,0],[1,0]]
              | x == 108 = [[0],[1,0],[2,1,0],[2,1,0]]
              | x == 109 = [[0],[1,0],[2,1,0],[3,2,1,0]]
-----------------------------------------------------------------------------
              | x == 150 || x == 154 = [[1],[2,1],[4,3,2]]  -- 4, 6, 7 are omitted but 2, 3, 5 are present.
              | x == 152 || x == 155 = [[1],[2],[4,3]]
              | x == 157 = [[0],[1,0],[1,0]]
              | x == 158 || x == 159 = [[0],[1,0],[2,1,0]]
-----------------------------------------------------------------
              | x == 170 || x == 174 = [[2,1],[4,3,2],[6,5,4,3,2]]  -- just 3, 5 and 7 are present
              | x == 172 || x == 175 = [[2],[4,3],[6,5,4]]
              | x == 177 = [[1,0],[1,0],[1,0]]
              | x == 178 = [[1,0],[2,1,0],[2,1,0]]
              | x == 179 = [[1,0],[2,1,0],[3,2,1,0]]
---------------------------------------------------------------------------------- 
              | otherwise = [[1],[1],[2,1],[3,2,1],[3,2],[4,3,2]]
--------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------
           sel2 y 
              | y == 1 || y < 0 || y > 179 = []
              | (rem y 10 `elem` [1,3,6]) || y >= 0 && y <= 9 = [2..7]
              | y >= 20 && y <= 69 = [2..toEnum (y `quot` 10)]
              | y >= 70 && y <= 99 = [toEnum (y `quot` 10) - 4..7]
              | y >= 100 && y <= 109 = [2,3,5,7]
              | y >= 150 && y <= 159 = [2,3,5]
              | y >= 170 && y <= 179 = [3,5,7]
              | otherwise = [2..7]
           minMax11ByCList :: Ord a => (a -> a -> Ordering) -> [a] -> (a, a) -- Is rewritten from the 'Data.MinMax.Preconditions.minMax11ByC' from @subG@ package.
           minMax11ByCList g xs@(x:y:ys) = foldr f (if x > y then (y, x) else (x, y)) ys
               where f z (x,y)
                        | g z x == LT = (z,y)
                        | g z y == GT = (x,z)
                        | otherwise = (x,y)
           minMax11ByCList _ _ = undefined -- Is not intended to be used for lists with less than two elements.
           jjj kk = let (q1,r1) = quotRem kk (if kk < 0 then -10 else 10) in jjj' q1 r1 emptyline
           jjj' q1 r1 emptyline
             | r1 == (-1) || r1 == (-3) = -10*q1 + (if emptyline then -5 else r1)
             | r1 == 1 || r1 == 3 = 10*q1 + (if emptyline then 5 else r1)
             | r1 < 0 = -10*q1 + (if emptyline then -4 else r1)
             | otherwise = 10*q1 + (if emptyline then 4 else r1)
generalF _ _ _ _ _ _ _ _ _ _ [u1] = mapM putStrLn [u1] >> return [u1]
generalF _ _ _ _ _ _ _ _ _ _ _ = let strOutput = ["You have specified the data and constraints on it that lead to no further possible options.", "Please, specify another data and constraints."] in mapM putStrLn strOutput >> return strOutput

data PhladiprelioUkr = S Int Integer String deriving Eq

instance Show PhladiprelioUkr where
  show (S i j xs) = showBignum 7 j `mappend` " " `mappend` xs `mappend` "  " `mappend` showWithSpaces 4 i

countSyll :: String -> Int
countSyll xs = fromEnum . foldr (\x y -> if isVowel1 x then y + 1 else y) 0 . convertToProperUkrainianI8 $ xs

stat1 :: Int -> (Int8,[Int8]) -> Int
stat1 n (k, ks) = fst (n `quotRemInt` fromEnum k) * length ks

parseHelp :: [String] -> (String,[String])
parseHelp xss 
  | null xss = ([],[])
  | otherwise = (unwords rss, uss `mappend` qss)
       where (yss,tss) = break (== "-b") xss
             (uss,wss) = break (== "+b") yss
             [qss,rss] = map (drop 1) [tss, wss]
             
outputSel :: PhladiprelioUkr -> Int -> String
outputSel (S x1 y1 ts) code
  | code < 0 = []
  | code == 0 = ts `mappend` "\n"
  | code == 1 = intercalate " " [show x1, ts] `mappend` "\n"
  | code == 2 = intercalate " " [show y1, ts] `mappend` "\n"
  | code == 3 = intercalate " " [show x1, ts, show y1] `mappend` "\n"
  | code == 4 = intercalate " " [show x1, show y1] `mappend` "\n"
  | otherwise = ts `mappend` "\n"

parseLineNumber :: Int -> IO Int
parseLineNumber l1 = do 
  putStrLn "Please, specify the number of the option to be written to the file specified: "
  number <- getLine
  let num = readMaybe (filter isDigit number)::Maybe Int
  if isNothing num || num > Just l1 || num == Just 0 
      then parseLineNumber l1 
      else return . fromJust $ num