{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2H
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Generalization and extension of the functionality of the DobutokO.Poetry.Norms
-- and DobutokO.Poetry.Norms.Extended modules
-- from the @dobutokO-poetry@ package. Uses syllables information.
-- Instead of the vector-related, uses just arrays.

{-# LANGUAGE CPP, BangPatterns, MultiWayIf #-}

module Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2H (
  -- * General
  parseChRhEndMaybe
  -- * Extended general
  , rhythmicityTup
) where

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import GHC.Base (mconcat)
#endif
#endif

import Phonetic.Languages.Array.Ukrainian.Common
import Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8
import Melodics.Ukrainian.ArrInt8 (Sound8,FlowSound)
import Languages.Phonetic.Ukrainian.Syllable.ArrInt8
import Data.Maybe (fromMaybe)
import Text.Read (readMaybe)
import Rhythmicity.TwoFourth
import Rhythmicity.PolyRhythm
import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG201
import GHC.Arr (Array)
import GHC.Int (Int8)
import Phonetic.Languages.Emphasis

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif

helperF4 :: Int -> [[[Sound8]]] -> [[Double]]
helperF4 :: Int -> [[[Sound8]]] -> [[Double]]
helperF4 Int
n
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [[[Sound8]]] -> [[Double]]
syllableDurationsD
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = [[[Sound8]]] -> [[Double]]
syllableDurationsD2
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = [[[Sound8]]] -> [[Double]]
syllableDurationsD3
 | Bool
otherwise = [[[Sound8]]] -> [[Double]]
syllableDurationsD4

----------------------------------------------------------------

rhythmicityTup
  :: Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Int8)
  -> Array Int (Int8, FlowSound -> Sound8)
  -> Array Int (Int8, Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int (Int8, [Int8])
  -> Array Int (Char,Int8)
  -> Array Int (Int8,[Int8])
  -> Array Int (Char, Bool)
  -> Array Int (Char, Bool)
  -> Array Int (Int8,Bool)
  -> Double
  -> String
  -> Coeffs2
  -> ReadyForConstructionUkr
  -> Double
rhythmicityTup :: Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> Double
-> String
-> Coeffs2
-> ReadyForConstructionUkr
-> Double
rhythmicityTup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 Double
k String
choice Coeffs2
CF0 tttt :: ReadyForConstructionUkr
tttt@(Str String
tttts)= if
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"c",String
"M",String
"N"] Bool -> Bool -> Bool
|| (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"A" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"F") -> let just_probe :: Maybe ParseChRh
just_probe = String -> Maybe ParseChRh
readRhythmicity String
choice in
           case Maybe ParseChRh
just_probe of
             Just (P1 Choices
ch RhythmBasis
rh Int
n) -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 Choices
ch RhythmBasis
rh ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat ([[Double]] -> [Double])
-> (String -> [[Double]]) -> String -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. -- the latter one is to be interchanged with weights2SyllableDurationsD
               (Int -> [[[Sound8]]] -> [[Double]]
helperF4 Int
n) ([[[Sound8]]] -> [[Double]])
-> (String -> [[[Sound8]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> String
-> [[[Sound8]]]
createSyllablesUkrSTup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
tttts
             Just (P2 PolyChoices
ch PolyRhythmBasis
rh Int
r Int
n) -> (case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice of
                   String
"A" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   String
"D" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   String
"E" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   String
"F" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   String
"B" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   String
"C" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   String
"M" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   String
"N" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   String
"c" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat ([[Double]] -> [Double])
-> (String -> [[Double]]) -> String -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [[[Sound8]]] -> [[Double]]
helperF4 Int
n) ([[[Sound8]]] -> [[Double]])
-> (String -> [[[Sound8]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> String
-> [[[Sound8]]]
createSyllablesUkrSTup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
tttts
             Maybe ParseChRh
_ -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> ReadyForConstructionUkr
-> Double
rhythmicity04Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 ReadyForConstructionUkr
tttt
 | String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0y" -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> ReadyForConstructionUkr
-> Double
rhythmicity0Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 ReadyForConstructionUkr
tttt
 | String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"02y" -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> ReadyForConstructionUkr
-> Double
rhythmicity02Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 ReadyForConstructionUkr
tttt
 | String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"03y" -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> ReadyForConstructionUkr
-> Double
rhythmicity03Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 ReadyForConstructionUkr
tttt
 | String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0z" -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicity0FTup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 Double
k ReadyForConstructionUkr
tttt
 | String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"02z" -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicity02FTup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17  Double
k ReadyForConstructionUkr
tttt
 | String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"03z" -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicity03FTup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 Double
k ReadyForConstructionUkr
tttt
 | String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"04z" -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicity04FTup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 Double
k ReadyForConstructionUkr
tttt
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0" -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> ReadyForConstructionUkr
-> Double
rhythmicity04Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 ReadyForConstructionUkr
tttt
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"w" -> if
          | (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"1" Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"4" ->
             case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice of
              String
"w0" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) String
tttts
              String
"w1" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) String
tttts
              String
"w2" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) String
tttts
              String
"w3" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) String
tttts
              String
_ -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> ReadyForConstructionUkr
-> Double
rhythmicity04Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 ReadyForConstructionUkr
tttt
          | Bool
otherwise -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> ReadyForConstructionUkr
-> Double
rhythmicity04Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 ReadyForConstructionUkr
tttt
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"x" -> if
          | (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"1" Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"4" ->
             case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice of
              String
"x0" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) String
tttts
              String
"x1" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) String
tttts
              String
"x2" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) String
tttts
              String
"x3" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) String
tttts
              String
_ -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> ReadyForConstructionUkr
-> Double
rhythmicity04Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 ReadyForConstructionUkr
tttt
          | Bool
otherwise -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> ReadyForConstructionUkr
-> Double
rhythmicity04Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 ReadyForConstructionUkr
tttt
 | Bool
otherwise -> if
    | (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"b" Bool -> Bool -> Bool
|| ((Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"d" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"v") Bool -> Bool -> Bool
|| (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"I" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"Z"))) Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"1" Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"4" ->
        (case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice of
          String
"b" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Int
5 Int
1
          String
"d" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF30 Int
5 Int
1
          String
"e" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Int
6 Int
2
          String
"f" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF30 Int
6 Int
2
          String
"g" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Int
5 Int
1
          String
"h" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF20 Int
5 Int
1
          String
"i" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Int
6 Int
2
          String
"j" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF20 Int
6 Int
2
          String
"k" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Int
5 Int
1
          String
"l" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF30 Int
5 Int
1
          String
"m" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Int
6 Int
2
          String
"n" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF30 Int
6 Int
2
          String
"o" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Int
5 Int
1
          String
"p" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF20 Int
5 Int
1
          String
"q" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Int
6 Int
2
          String
"r" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF20 Int
6 Int
2
          String
"I" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Int
5 Int
1
          String
"J" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF30 Int
5 Int
1
          String
"K" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Int
6 Int
2
          String
"L" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF30 Int
6 Int
2
          String
"O" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Int
5 Int
1
          String
"P" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF20 Int
5 Int
1
          String
"Q" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Int
6 Int
2
          String
"R" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF20 Int
6 Int
2
          String
"W" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Int
5 Int
1
          String
"X" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF30 Int
5 Int
1
          String
"Y" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Int
6 Int
2
          String
"Z" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF30 Int
6 Int
2
          String
"U" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Int
5 Int
1
          String
"V" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF20 Int
5 Int
1
          String
"S" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Int
6 Int
2
          String
"T" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF20 Int
6 Int
2
          String
"u" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Int
5 Int
1
          String
"v" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly0 Int
5 Int
1
          String
"s" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Int
6 Int
2
          String
"t" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly0 Int
6 Int
2) String
tttts
    | Bool
otherwise -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> ReadyForConstructionUkr
-> Double
rhythmicity04Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 ReadyForConstructionUkr
tttt
        where h1 :: (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f String
ts [Bool]
xs Int
m Int
n = t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f t
1.0 t
4 ([Bool] -> Int -> PolyChoices
PolyCh [Bool]
xs Int
m) ([Int] -> PolyRhythmBasis
PolyRhythm [Int
1,Int
2,Int
1,Int
n]) ([Double] -> c) -> (String -> [Double]) -> String -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat ([[Double]] -> [Double])
-> (String -> [[Double]]) -> String -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
ts::Maybe Int of { Just Int
1 -> [[[Sound8]]] -> [[Double]]
syllableDurationsD ; Just Int
2 -> [[[Sound8]]] -> [[Double]]
syllableDurationsD2 ; Just Int
3 -> [[[Sound8]]] -> [[Double]]
syllableDurationsD3 ; Just Int
4 -> [[[Sound8]]] -> [[Double]]
syllableDurationsD4 }) ([[[Sound8]]] -> [[Double]])
-> (String -> [[[Sound8]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> String
-> [[[Sound8]]]
createSyllablesUkrSTup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17
              h2 :: (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f String
ts [Bool]
xs Int
m Int
n = t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f t
1.0 t
4 ([Bool] -> Int -> PolyChoices
PolyCh [Bool]
xs Int
m) ([Int] -> PolyRhythmBasis
PolyRhythm [Int
2,Int
1,Int
1,Int
n]) ([Double] -> c) -> (String -> [Double]) -> String -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat ([[Double]] -> [Double])
-> (String -> [[Double]]) -> String -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
ts::Maybe Int of { Just Int
1 -> [[[Sound8]]] -> [[Double]]
syllableDurationsD ; Just Int
2 -> [[[Sound8]]] -> [[Double]]
syllableDurationsD2 ; Just Int
3 -> [[[Sound8]]] -> [[Double]]
syllableDurationsD3 ; Just Int
4 -> [[[Sound8]]] -> [[Double]]
syllableDurationsD4 }) ([[[Sound8]]] -> [[Double]])
-> (String -> [[[Sound8]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> String
-> [[[Sound8]]]
createSyllablesUkrSTup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17
              g :: (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"01",String
"02",String
"03",String
"04"] = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
True,Bool
True] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"11",String
"12",String
"13",String
"14"] = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
True,Bool
False] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"21",String
"22",String
"23",String
"24"] = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
False,Bool
True] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"31",String
"32",String
"33",String
"34"] = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
False,Bool
False] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"41",String
"42",String
"43",String
"44"] = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
True,Bool
True] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"51",String
"52",String
"53",String
"54"] = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
True,Bool
False] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"61",String
"62",String
"63",String
"64"] = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
False,Bool
True] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"71",String
"72",String
"73",String
"74"] = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
False,Bool
False] Int
m Int
n
                | Bool
otherwise = \String
_ -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> ReadyForConstructionUkr
-> Double
rhythmicity04Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 ReadyForConstructionUkr
tttt
              w1F :: ([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F [[[Sound8]]] -> [[a]]
f Choices
ch RhythmBasis
rh = Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 Choices
ch RhythmBasis
rh ([a] -> Double) -> (String -> [a]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall a. Monoid a => [a] -> a
mconcat ([[a]] -> [a]) -> (String -> [[a]]) -> String -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[a]]
f ([[[Sound8]]] -> [[a]])
-> (String -> [[[Sound8]]]) -> String -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> String
-> [[[Sound8]]]
createSyllablesUkrSTup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17
              wwF2 :: (([[[Sound8]]] -> [[Double]]) -> p) -> String -> p
wwF2 ([[[Sound8]]] -> [[Double]]) -> p
g2 String
xs = let (Just Int
n) = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
xs::Maybe Int in
                      case Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
4 of
                       Int
1 -> ([[[Sound8]]] -> [[Double]]) -> p
g2 [[[Sound8]]] -> [[Double]]
syllableDurationsD
                       Int
2 -> ([[[Sound8]]] -> [[Double]]) -> p
g2 [[[Sound8]]] -> [[Double]]
syllableDurationsD2
                       Int
3 -> ([[[Sound8]]] -> [[Double]]) -> p
g2 [[[Sound8]]] -> [[Double]]
syllableDurationsD3
                       Int
_ -> ([[[Sound8]]] -> [[Double]]) -> p
g2 [[[Sound8]]] -> [[Double]]
syllableDurationsD4
              x1F :: ([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F [[[Sound8]]] -> [[a]]
f Choices
ch RhythmBasis
rh = Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 Choices
ch RhythmBasis
rh ([a] -> Double) -> (String -> [a]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall a. Monoid a => [a] -> a
mconcat ([[a]] -> [a]) -> (String -> [[a]]) -> String -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[a]]
f ([[[Sound8]]] -> [[a]])
-> (String -> [[[Sound8]]]) -> String -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> String
-> [[[Sound8]]]
createSyllablesUkrSTup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17
              xxF :: String -> Choices -> RhythmBasis -> String -> Double
xxF = (([[[Sound8]]] -> [[Double]])
 -> Choices -> RhythmBasis -> String -> Double)
-> String -> Choices -> RhythmBasis -> String -> Double
forall p. (([[[Sound8]]] -> [[Double]]) -> p) -> String -> p
wwF2 ([[[Sound8]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F
              wwF :: String -> Choices -> RhythmBasis -> String -> Double
wwF = (([[[Sound8]]] -> [[Double]])
 -> Choices -> RhythmBasis -> String -> Double)
-> String -> Choices -> RhythmBasis -> String -> Double
forall p. (([[[Sound8]]] -> [[Double]]) -> p) -> String -> p
wwF2 ([[[Sound8]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F
              {-# INLINE w1F #-}
              {-# INLINE wwF2 #-}
              {-# INLINE x1F #-}
              {-# INLINE xxF #-}
              {-# INLINE wwF #-}
rhythmicityTup  Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 Double
k String
choice (CF2 Maybe Double
x Maybe Double
y) tttt :: ReadyForConstructionUkr
tttt@(Str String
tttts) =
 case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice of
  String
"0" -> (case String
choice of
           String
"0y" -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityKTup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17  (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
           String
"02y" -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityK2Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
           String
"03y" -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityK3Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
           String
"0z" -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> Double
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityKFTup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 Double
k (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
           String
"02z" -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> Double
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityKF2Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 Double
k (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
           String
"03z" -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> Double
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityKF3Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 Double
k (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
           String
"04z" -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> Double
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityKF4Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 Double
k (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
           String
_ -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityK4Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)) ReadyForConstructionUkr
tttt
  String
"w" -> if
          | (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"1" Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"4" ->
             case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice of
              String
"w0" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) String
tttts
              String
"w1" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) String
tttts
              String
"w2" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) String
tttts
              String
"w3" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) String
tttts
              String
_ -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> ReadyForConstructionUkr
-> Double
rhythmicity04Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 ReadyForConstructionUkr
tttt
          | Bool
otherwise -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> ReadyForConstructionUkr
-> Double
rhythmicity04Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 ReadyForConstructionUkr
tttt
              where w1F :: ([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F [[[Sound8]]] -> [[a]]
f Choices
ch RhythmBasis
rh = Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) Choices
ch RhythmBasis
rh ([a] -> Double) -> (String -> [a]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall a. Monoid a => [a] -> a
mconcat ([[a]] -> [a]) -> (String -> [[a]]) -> String -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[a]]
f ([[[Sound8]]] -> [[a]])
-> (String -> [[[Sound8]]]) -> String -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> String
-> [[[Sound8]]]
createSyllablesUkrSTup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17
                    wwF :: String -> Choices -> RhythmBasis -> String -> Double
wwF String
xs = let (Just Int
n) = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
xs::Maybe Int in
                      case Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
4 of
                       Int
1 -> ([[[Sound8]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F [[[Sound8]]] -> [[Double]]
syllableDurationsD
                       Int
2 -> ([[[Sound8]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F [[[Sound8]]] -> [[Double]]
syllableDurationsD2
                       Int
3 -> ([[[Sound8]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F [[[Sound8]]] -> [[Double]]
syllableDurationsD3
                       Int
_ -> ([[[Sound8]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F [[[Sound8]]] -> [[Double]]
syllableDurationsD4
                    {-# INLINE w1F #-}
                    {-# INLINE wwF #-}
  String
"x" -> if
          | (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"1" Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"4" ->
             case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice of
              String
"x0" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) String
tttts
              String
"x1" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) String
tttts
              String
"x2" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) String
tttts
              String
"x3" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) String
tttts
              String
_ -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> ReadyForConstructionUkr
-> Double
rhythmicity04Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 ReadyForConstructionUkr
tttt
          | Bool
otherwise -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> ReadyForConstructionUkr
-> Double
rhythmicity04Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 ReadyForConstructionUkr
tttt
              where x1F :: ([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F [[[Sound8]]] -> [[a]]
f Choices
ch RhythmBasis
rh = Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) Choices
ch RhythmBasis
rh ([a] -> Double) -> (String -> [a]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall a. Monoid a => [a] -> a
mconcat ([[a]] -> [a]) -> (String -> [[a]]) -> String -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[a]]
f ([[[Sound8]]] -> [[a]])
-> (String -> [[[Sound8]]]) -> String -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> String
-> [[[Sound8]]]
createSyllablesUkrSTup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17
                    xxF :: String -> Choices -> RhythmBasis -> String -> Double
xxF String
xs = let (Just Int
n) = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
xs::Maybe Int in
                      case Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
4 of
                       Int
1 -> ([[[Sound8]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F [[[Sound8]]] -> [[Double]]
syllableDurationsD
                       Int
2 -> ([[[Sound8]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F [[[Sound8]]] -> [[Double]]
syllableDurationsD2
                       Int
3 -> ([[[Sound8]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F [[[Sound8]]] -> [[Double]]
syllableDurationsD3
                       Int
_ -> ([[[Sound8]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F [[[Sound8]]] -> [[Double]]
syllableDurationsD4
                    {-# INLINE x1F #-}
                    {-# INLINE xxF #-}
  String
_ -> if
     | ((Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"b" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"v") Bool -> Bool -> Bool
|| (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"A" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"Z" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
"G",String
"H"])) -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> Double
-> String
-> Coeffs2
-> ReadyForConstructionUkr
-> Double
rhythmicityTup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17  Double
k String
choice Coeffs2
forall a. CoeffTwo a
CF0 ReadyForConstructionUkr
tttt
     | Bool
otherwise -> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityK4Tup Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17  (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y) ReadyForConstructionUkr
tttt
rhythmicityTup  Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 Double
k String
choice Coeffs2
_ ReadyForConstructionUkr
_ = -Double
1.0