{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Hprime
-- 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.PropertiesSyllablesG2Hprime (
  -- * Extended
  rhythmicityHTup
  , rhythmicityH'Tup
  , rhythmicitya'Tup
) 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 Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2H
import GHC.Arr (Array)
import GHC.Int (Int8)
import Phonetic.Languages.Emphasis
import Phonetic.Languages.Coeffs

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

helperHF4 :: Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 :: Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
n [[[[Sound8]]] -> [[Double]]]
xs
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[[[Sound8]]] -> [[Double]]]
xs = [[[Sound8]]] -> [[Double]]
syllableDurationsD4
  | (Int
n forall a. Integral a => a -> a -> a
`rem` forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[[Sound8]]] -> [[Double]]]
xs) forall a. Eq a => a -> a -> Bool
== Int
0 = forall a. [a] -> a
head [[[[Sound8]]] -> [[Double]]]
xs
  | Bool
otherwise = [[[[Sound8]]] -> [[Double]]]
xs forall a. [a] -> Int -> a
!! ((Int
n forall a. Integral a => a -> a -> a
`rem` forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[[Sound8]]] -> [[Double]]]
xs) forall a. Num a => a -> a -> a
- Int
1)

helperHF1 :: Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 :: Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
n [[[[Sound8]]] -> [[Double]]]
xs
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[[[Sound8]]] -> [[Double]]]
xs = \[[[Sound8]]]
_ -> []
  | (Int
n forall a. Integral a => a -> a -> a
`rem` forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[[Sound8]]] -> [[Double]]]
xs) forall a. Eq a => a -> a -> Bool
== Int
0 = forall a. [a] -> a
head [[[[Sound8]]] -> [[Double]]]
xs
  | Bool
otherwise = [[[[Sound8]]] -> [[Double]]]
xs forall a. [a] -> Int -> a
!! ((Int
n forall a. Integral a => a -> a -> a
`rem` forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[[Sound8]]] -> [[Double]]]
xs) forall a. Num a => a -> a -> a
- Int
1)  

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

{-|
-}
rhythmicityHTup
  :: 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
  -> [[[[Sound8]]] -> [[Double]]]
  -> Coeffs2
  -> String
  -> ReadyForConstructionUkr
  -> Double
rhythmicityHTup :: 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
-> [Char]
-> [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> [Char]
-> ReadyForConstructionUkr
-> Double
rhythmicityHTup 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 [Char]
choice [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs [Char]
bbs
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'a') [Char]
choice = 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
-> [Char]
-> [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> [Char]
-> ReadyForConstructionUkr
-> Double
rhythmicitya'Tup 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 (forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/=Char
'a' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/=  Char
'H') [Char]
choice) [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs [Char]
bbs
  | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"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
-> [Char]
-> [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> ReadyForConstructionUkr
-> Double
rhythmicityH'Tup 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 (forall a. Int -> [a] -> [a]
drop Int
1 [Char]
choice) [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs
  | 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
-> [Char]
-> 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 [Char]
choice Coeffs2
coeffs

rhythmicityH'Tup
  :: 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
  -> [[[[Sound8]]] -> [[Double]]]
  -> Coeffs2
  -> ReadyForConstructionUkr
  -> Double
rhythmicityH'Tup :: 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
-> [Char]
-> [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> ReadyForConstructionUkr
-> Double
rhythmicityH'Tup 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 [Char]
choice [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Coeffs2
CF0 tttt :: ReadyForConstructionUkr
tttt@(Str [Char]
tttts) = if
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"c",[Char]
"M",[Char]
"N"] Bool -> Bool -> Bool
|| (forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
>= [Char]
"A" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
<= [Char]
"F") -> let just_probe :: Maybe ParseChRh
just_probe = [Char] -> Maybe ParseChRh
readRhythmicity [Char]
choice in
           (case Maybe ParseChRh
just_probe of
             Just (P1 Choices
ch RhythmBasis
rh Int
n) -> 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 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> [Double]
rhythmicityGTup 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 (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
n [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs)
             Just (P2 PolyChoices
ch PolyRhythmBasis
rh Int
r Int
n) -> (case forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice of
                   [Char]
"A" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"D" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"E" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"F" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"B" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"C" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"M" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"N" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"c" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh) 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> [Double]
rhythmicityGTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
n [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs)
             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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs)) ReadyForConstructionUkr
tttt
 | [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"0" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
drop Int
2 (forall a. Int -> [a] -> [a]
take Int
3 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"y" ->
    let n2 :: Maybe Int
n2 = forall a. Read a => [Char] -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ [Char]
choice)::Maybe Int in
      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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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
        (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 (case Maybe Int
n2 of { Just Int
n3 -> Int
n3; Maybe Int
Nothing -> Int
1}) [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
 | [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"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)
-> ([[[Sound8]]] -> [[Double]])
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicity0FHTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) Double
k ReadyForConstructionUkr
tttt
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"0" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
drop Int
2 (forall a. Int -> [a] -> [a]
take Int
3 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"z" ->
    let n2 :: Maybe Int
n2 = forall a. Read a => [Char] -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ [Char]
choice)::Maybe Int in
      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)
-> ([[[Sound8]]] -> [[Double]])
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicity0FHTup 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
          (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 (case Maybe Int
n2 of { Just Int
n3 -> Int
n3; Maybe Int
Nothing -> Int
1}) [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) Double
k ReadyForConstructionUkr
tttt
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"w" -> if
          | (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
>= [Char]
"1" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
<= [Char]
"4" ->
             case forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice of
              [Char]
"w0" -> [Char] -> Choices -> RhythmBasis -> [Char] -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) [Char]
tttts
              [Char]
"w1" -> [Char] -> Choices -> RhythmBasis -> [Char] -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) [Char]
tttts
              [Char]
"w2" -> [Char] -> Choices -> RhythmBasis -> [Char] -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) [Char]
tttts
              [Char]
"w3" -> [Char] -> Choices -> RhythmBasis -> [Char] -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) [Char]
tttts
              [Char]
_ -> 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"x" -> if
          | (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
>= [Char]
"1" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
<= [Char]
"4" ->
             case forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice of
              [Char]
"x0" -> [Char] -> Choices -> RhythmBasis -> [Char] -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) [Char]
tttts
              [Char]
"x1" -> [Char] -> Choices -> RhythmBasis -> [Char] -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) [Char]
tttts
              [Char]
"x2" -> [Char] -> Choices -> RhythmBasis -> [Char] -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) [Char]
tttts
              [Char]
"x3" -> [Char] -> Choices -> RhythmBasis -> [Char] -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) [Char]
tttts
              [Char]
_ -> 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
 | Bool
otherwise -> if
    | (forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"b" Bool -> Bool -> Bool
|| ((forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
>= [Char]
"d" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
<= [Char]
"v") Bool -> Bool -> Bool
|| (forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
>= [Char]
"I" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
<= [Char]
"Z"))) Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
>= [Char]
"1" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
<= [Char]
"9" ->
        (case forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice of
          [Char]
"b" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Int
5 Int
1
          [Char]
"d" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF30 Int
5 Int
1
          [Char]
"e" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Int
6 Int
2
          [Char]
"f" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF30 Int
6 Int
2
          [Char]
"g" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Int
5 Int
1
          [Char]
"h" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF20 Int
5 Int
1
          [Char]
"i" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Int
6 Int
2
          [Char]
"j" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF20 Int
6 Int
2
          [Char]
"k" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Int
5 Int
1
          [Char]
"l" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF30 Int
5 Int
1
          [Char]
"m" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Int
6 Int
2
          [Char]
"n" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF30 Int
6 Int
2
          [Char]
"o" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Int
5 Int
1
          [Char]
"p" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF20 Int
5 Int
1
          [Char]
"q" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Int
6 Int
2
          [Char]
"r" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF20 Int
6 Int
2
          [Char]
"I" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Int
5 Int
1
          [Char]
"J" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF30 Int
5 Int
1
          [Char]
"K" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Int
6 Int
2
          [Char]
"L" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF30 Int
6 Int
2
          [Char]
"O" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Int
5 Int
1
          [Char]
"P" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF20 Int
5 Int
1
          [Char]
"Q" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Int
6 Int
2
          [Char]
"R" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF20 Int
6 Int
2
          [Char]
"W" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Int
5 Int
1
          [Char]
"X" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF30 Int
5 Int
1
          [Char]
"Y" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Int
6 Int
2
          [Char]
"Z" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF30 Int
6 Int
2
          [Char]
"U" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Int
5 Int
1
          [Char]
"V" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF20 Int
5 Int
1
          [Char]
"S" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Int
6 Int
2
          [Char]
"T" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF20 Int
6 Int
2
          [Char]
"u" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Int
5 Int
1
          [Char]
"v" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly0 Int
5 Int
1
          [Char]
"s" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Int
6 Int
2
          [Char]
"t" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [Char] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly0 Int
6 Int
2) [Char]
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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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
       (let ts :: [Char]
ts = forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice in
          case [Char]
ts of { [] -> [[[Sound8]]] -> [[Double]]
syllableDurationsD4 ; [Char]
ks ->
            let q :: Maybe Int
q = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ks::Maybe Int in
              case Maybe Int
q of {Just Int
q' -> Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
q' [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs; ~Maybe Int
Nothing -> [[[Sound8]]] -> [[Double]]
syllableDurationsD4 }}) ReadyForConstructionUkr
tttt
        where h1 :: (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [Char] -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f [Char]
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]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (case [Char]
ts of { [] -> [[[Sound8]]] -> [[Double]]
syllableDurationsD4 ; [Char]
ks -> let q :: Maybe Int
q = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ks::Maybe Int in
                      case Maybe Int
q of {Just Int
q' -> Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
q' [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs; ~Maybe Int
Nothing -> [[[Sound8]]] -> [[Double]]
syllableDurationsD4 }}) 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)
-> [Char]
-> [[[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)
-> [Char] -> [Bool] -> Int -> Int -> [Char] -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f [Char]
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]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (case [Char]
ts of { [] -> [[[Sound8]]] -> [[Double]]
syllableDurationsD4 ; [Char]
ks -> let q :: Maybe Int
q = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ks::Maybe Int in
                      case Maybe Int
q of {Just Int
q' -> Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
q' [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs; ~Maybe Int
Nothing -> [[[Sound8]]] -> [[Double]]
syllableDurationsD4 }}) 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)
-> [Char]
-> [[[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 -> [Char] -> Double
g t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"0" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [Char] -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
True,Bool
True] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"1" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [Char] -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
True,Bool
False] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"2" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [Char] -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
False,Bool
True] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"3" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [Char] -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
False,Bool
False] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"4" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [Char] -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
True,Bool
True] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"5" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [Char] -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
True,Bool
False] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"6" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [Char] -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
False,Bool
True] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"7" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [Char] -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
False,Bool
False] Int
m Int
n
                | Bool
otherwise = \[Char]
_ -> 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
n [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
              w1F :: ([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> [Char] -> Double
w1F [[[Sound8]]] -> [[a]]
f Choices
ch RhythmBasis
rh = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[a]]
f 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)
-> [Char]
-> [[[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]]) -> t) -> [Char] -> t
wwF2 ([[[Sound8]]] -> [[Double]]) -> t
g2 [Char]
xs =
                let n1 :: Maybe Int
n1 = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
xs::Maybe Int in
                   case Maybe Int
n1 of
                     Just Int
n2 -> ([[[Sound8]]] -> [[Double]]) -> t
g2 (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
n2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs)
                     Maybe Int
Nothing -> ([[[Sound8]]] -> [[Double]]) -> t
g2 [[[Sound8]]] -> [[Double]]
syllableDurationsD4
              x1F :: ([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> [Char] -> Double
x1F [[[Sound8]]] -> [[a]]
f Choices
ch RhythmBasis
rh = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[a]]
f 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)
-> [Char]
-> [[[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 :: [Char] -> Choices -> RhythmBasis -> [Char] -> Double
xxF = forall {t}. (([[[Sound8]]] -> [[Double]]) -> t) -> [Char] -> t
wwF2 forall {a}.
Ord a =>
([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> [Char] -> Double
x1F
              wwF :: [Char] -> Choices -> RhythmBasis -> [Char] -> Double
wwF = forall {t}. (([[[Sound8]]] -> [[Double]]) -> t) -> [Char] -> t
wwF2 forall {a}.
Ord a =>
([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> [Char] -> Double
w1F
              {-# INLINE w1F #-}
              {-# INLINE wwF2 #-}
              {-# INLINE x1F #-}
              {-# INLINE xxF #-}
              {-# INLINE wwF #-}
rhythmicityH'Tup 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 [Char]
choice [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs (CF2 Maybe Double
x Maybe Double
y) tttt :: ReadyForConstructionUkr
tttt@(Str [Char]
tttts) =
 case forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice of
  [Char]
"0" -> if [Char]
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"0z",[Char]
"02z",[Char]
"03z",[Char]
"04z"] then 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)
-> ([[[Sound8]]] -> [[Double]])
-> Double
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityKFHTup 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 (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 (case forall a. [a] -> a
last [Char]
choice of {Char
'2' -> Int
2; Char
'3' -> Int
3; Char
'4' -> Int
4; ~Char
rrrrr -> Int
1}) [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) Double
k
             (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y) ReadyForConstructionUkr
tttt
          else 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)
-> ([[[Sound8]]] -> [[Double]])
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityKHTup 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
            (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 (case forall a. [a] -> a
last [Char]
choice of {Char
'2' -> Int
2; Char
'3' -> Int
3; Char
'4' -> Int
4; ~Char
rrrrr -> Int
1}) [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y) ReadyForConstructionUkr
tttt
  [Char]
"w" -> if
          | (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
>= [Char]
"1" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
<= [Char]
"4" ->
             case forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice of
              [Char]
"w0" -> [Char] -> Choices -> RhythmBasis -> [Char] -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) [Char]
tttts
              [Char]
"w1" -> [Char] -> Choices -> RhythmBasis -> [Char] -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) [Char]
tttts
              [Char]
"w2" -> [Char] -> Choices -> RhythmBasis -> [Char] -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) [Char]
tttts
              [Char]
"w3" -> [Char] -> Choices -> RhythmBasis -> [Char] -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) [Char]
tttts
              [Char]
_ -> 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
              where w1F :: ([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> [Char] -> Double
w1F [[[Sound8]]] -> [[a]]
f Choices
ch RhythmBasis
rh = forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) Choices
ch RhythmBasis
rh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[a]]
f 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)
-> [Char]
-> [[[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 :: [Char] -> Choices -> RhythmBasis -> [Char] -> Double
wwF [Char]
xs =
                      let n1 :: Maybe Int
n1 = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
xs::Maybe Int in
                        case Maybe Int
n1 of
                         Just Int
n2 -> forall {a}.
Ord a =>
([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> [Char] -> Double
w1F (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
n2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs)
                         Maybe Int
Nothing -> forall {a}.
Ord a =>
([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> [Char] -> Double
w1F [[[Sound8]]] -> [[Double]]
syllableDurationsD4
                    {-# INLINE w1F #-}
                    {-# INLINE wwF #-}
  [Char]
"x" -> if
          | (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
>= [Char]
"1" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
<= [Char]
"4" ->
             case forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice of
              [Char]
"x0" -> [Char] -> Choices -> RhythmBasis -> [Char] -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) [Char]
tttts
              [Char]
"x1" -> [Char] -> Choices -> RhythmBasis -> [Char] -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) [Char]
tttts
              [Char]
"x2" -> [Char] -> Choices -> RhythmBasis -> [Char] -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) [Char]
tttts
              [Char]
"x3" -> [Char] -> Choices -> RhythmBasis -> [Char] -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) [Char]
tttts
              [Char]
_ -> 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
              where x1F :: ([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> [Char] -> Double
x1F [[[Sound8]]] -> [[a]]
f Choices
ch RhythmBasis
rh = forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) Choices
ch RhythmBasis
rh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[a]]
f 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)
-> [Char]
-> [[[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 :: [Char] -> Choices -> RhythmBasis -> [Char] -> Double
xxF [Char]
xs =
                      let n1 :: Maybe Int
n1 = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
xs::Maybe Int in
                        case Maybe Int
n1 of
                         Just Int
n2 -> forall {a}.
Ord a =>
([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> [Char] -> Double
x1F (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
n2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs)
                         Maybe Int
Nothing -> forall {a}.
Ord a =>
([[[Sound8]]] -> [[a]])
-> Choices -> RhythmBasis -> [Char] -> Double
x1F [[[Sound8]]] -> [[Double]]
syllableDurationsD4
                    {-# INLINE x1F #-}
                    {-# INLINE xxF #-}
  [Char]
_ -> if
     | ((forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
>= [Char]
"b" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
<= [Char]
"v") Bool -> Bool -> Bool
|| (forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
>= [Char]
"A" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
<= [Char]
"Z" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]
"G",[Char]
"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
-> [Char]
-> [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> ReadyForConstructionUkr
-> Double
rhythmicityH'Tup 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 [Char]
choice [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs 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)
-> ([[[Sound8]]] -> [[Double]])
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityKHTup 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 
        (let ts :: [Char]
ts = forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice in
          case [Char]
ts of { [] -> [[[Sound8]]] -> [[Double]]
syllableDurationsD4 ; [Char]
ks ->
            let q :: Maybe Int
q = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ks::Maybe Int in
              case Maybe Int
q of {Just Int
q' -> Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF4 Int
q' [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs; ~Maybe Int
Nothing -> [[[Sound8]]] -> [[Double]]
syllableDurationsD4 }})
                (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y) ReadyForConstructionUkr
tttt
rhythmicityH'Tup 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
_ [Char]
_ [[[[Sound8]]] -> [[Double]]]
_ Coeffs2
_ ReadyForConstructionUkr
_ = -Double
3.0

rhythmicitya'Tup
  :: 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
  -> [[[[Sound8]]] -> [[Double]]]
  -> Coeffs2
  -> String
  -> ReadyForConstructionUkr
  -> Double
rhythmicitya'Tup :: 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
-> [Char]
-> [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> [Char]
-> ReadyForConstructionUkr
-> Double
rhythmicitya'Tup 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 [Char]
choice [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Coeffs2
CF0 [Char]
bbs tttt :: ReadyForConstructionUkr
tttt@(FSL [[[Sound8]]]
tttts)= if
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"c",[Char]
"M",[Char]
"N"] Bool -> Bool -> Bool
|| (forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
>= [Char]
"A" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
<= [Char]
"F") -> let just_probe :: Maybe ParseChRh
just_probe = [Char] -> Maybe ParseChRh
readRhythmicity [Char]
choice in
           (case Maybe ParseChRh
just_probe of
             Just (P1 Choices
ch RhythmBasis
rh Int
n) -> 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 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> [Double]
rhythmicityGTup 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 (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
n [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs)
             Just (P2 PolyChoices
ch PolyRhythmBasis
rh Int
r Int
n) -> (case forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice of
                   [Char]
"A" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"D" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"E" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"F" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"B" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"C" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"M" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"N" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"c" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh) 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> [Double]
rhythmicityGTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
n [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs)
             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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs))  ReadyForConstructionUkr
tttt
 | [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"0" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
drop Int
2 (forall a. Int -> [a] -> [a]
take Int
3 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"y" ->
    let n2 :: Maybe Int
n2 = forall a. Read a => [Char] -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ [Char]
choice)::Maybe Int in
      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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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
          (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 (case Maybe Int
n2 of {Just Int
n3 -> Int
n3; Maybe Int
Nothing -> Int
1}) [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
 | [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"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)
-> ([[[Sound8]]] -> [[Double]])
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicity0FHTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) Double
k ReadyForConstructionUkr
tttt
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"0" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
drop Int
2 (forall a. Int -> [a] -> [a]
take Int
3 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"z" ->
    let n2 :: Maybe Int
n2 = forall a. Read a => [Char] -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ [Char]
choice)::Maybe Int in
      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)
-> ([[[Sound8]]] -> [[Double]])
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicity0FHTup 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
          (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 (case Maybe Int
n2 of {Just Int
n3 -> Int
n3; Maybe Int
Nothing -> Int
1}) [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) Double
k ReadyForConstructionUkr
tttt
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"w" -> if
          | (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
>= [Char]
"1" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
<= [Char]
"4" ->
             (case forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice of
              [Char]
"w0" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) 
              [Char]
"w1" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) 
              [Char]
"w2" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) 
              [Char]
"w3" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) 
              [Char]
_ -> \[[[Sound8]]]
_ -> 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt) [[[Sound8]]]
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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"x" -> if
          | (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
>= [Char]
"1" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
<= [Char]
"4" ->
             (case forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice of
              [Char]
"x0" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              [Char]
"x1" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1)
              [Char]
"x2" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1)
              [Char]
"x3" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              [Char]
_ -> \[[[Sound8]]]
_ -> 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt) [[[Sound8]]]
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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
 | Bool
otherwise -> if
    | (forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"b" Bool -> Bool -> Bool
|| ((forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
>= [Char]
"d" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
<= [Char]
"v") Bool -> Bool -> Bool
|| (forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
>= [Char]
"I" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
<= [Char]
"Z"))) Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
>= [Char]
"1" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
<= [Char]
"9" ->
        (case forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice of
          [Char]
"b" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Int
5 Int
1
          [Char]
"d" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF30 Int
5 Int
1
          [Char]
"e" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Int
6 Int
2
          [Char]
"f" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF30 Int
6 Int
2
          [Char]
"g" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Int
5 Int
1
          [Char]
"h" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF20 Int
5 Int
1
          [Char]
"i" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Int
6 Int
2
          [Char]
"j" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF20 Int
6 Int
2
          [Char]
"k" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Int
5 Int
1
          [Char]
"l" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF30 Int
5 Int
1
          [Char]
"m" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Int
6 Int
2
          [Char]
"n" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF30 Int
6 Int
2
          [Char]
"o" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Int
5 Int
1
          [Char]
"p" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF20 Int
5 Int
1
          [Char]
"q" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Int
6 Int
2
          [Char]
"r" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF20 Int
6 Int
2
          [Char]
"I" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Int
5 Int
1
          [Char]
"J" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF30 Int
5 Int
1
          [Char]
"K" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Int
6 Int
2
          [Char]
"L" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF30 Int
6 Int
2
          [Char]
"O" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Int
5 Int
1
          [Char]
"P" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF20 Int
5 Int
1
          [Char]
"Q" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Int
6 Int
2
          [Char]
"R" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF20 Int
6 Int
2
          [Char]
"W" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Int
5 Int
1
          [Char]
"X" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF30 Int
5 Int
1
          [Char]
"Y" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Int
6 Int
2
          [Char]
"Z" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF30 Int
6 Int
2
          [Char]
"U" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Int
5 Int
1
          [Char]
"V" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF20 Int
5 Int
1
          [Char]
"S" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Int
6 Int
2
          [Char]
"T" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF20 Int
6 Int
2
          [Char]
"u" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Int
5 Int
1
          [Char]
"v" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly0 Int
5 Int
1
          [Char]
"s" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Int
6 Int
2
          [Char]
"t" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly0 Int
6 Int
2) [[[Sound8]]]
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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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
       (let ts :: [Char]
ts = forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice in
          case [Char]
ts of { [] -> (\[[[Sound8]]]
_ -> [[-Double
1.0]]) ; [Char]
ks ->
            let q :: Maybe Int
q = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ks::Maybe Int in
              case Maybe Int
q of {Just Int
q' -> Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
q' [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs; ~Maybe Int
Nothing -> (\[[[Sound8]]]
_ -> [[-Double
1.0]]) }}) ReadyForConstructionUkr
tttt
        where h1 :: (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f [Char]
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]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (case [Char]
ts of { [] -> (\[[[Sound8]]]
_ -> [[-Double
1.0]]) ; [Char]
ks -> let q :: Maybe Int
q = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ks::Maybe Int in
                      case Maybe Int
q of {Just Int
q' -> Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
q' [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs; ~Maybe Int
Nothing -> (\[[[Sound8]]]
_ -> [[-Double
1.0]]) }})
              h2 :: (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f [Char]
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]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (case [Char]
ts of { [] -> (\[[[Sound8]]]
_ -> [[-Double
1.0]]) ; [Char]
ks -> let q :: Maybe Int
q = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ks::Maybe Int in
                      case Maybe Int
q of {Just Int
q' -> Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
q' [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs; ~Maybe Int
Nothing -> (\[[[Sound8]]]
_ -> [[-Double
1.0]]) }})
              g :: (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"0" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
True,Bool
True] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"1" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
True,Bool
False] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"2" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
False,Bool
True] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"3" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
False,Bool
False] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"4" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
True,Bool
True] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"5" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
True,Bool
False] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"6" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
False,Bool
True] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"7" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
False,Bool
False] Int
m Int
n
                | Bool
otherwise = \[[[Sound8]]]
_ -> 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
n [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
              w1F :: ([[[Sound8]]] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
w1F [[[Sound8]]] -> [[a]]
f Choices
ch RhythmBasis
rh = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[a]]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\a
_ -> [[[Sound8]]]
tttts)
              wwF2 :: (([[[Sound8]]] -> [[Double]]) -> t) -> [Char] -> t
wwF2 ([[[Sound8]]] -> [[Double]]) -> t
g2 [Char]
xs =
                let n1 :: Maybe Int
n1 = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
xs::Maybe Int in
                   case Maybe Int
n1 of
                     Just Int
n2 -> ([[[Sound8]]] -> [[Double]]) -> t
g2 (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
n2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs)
                     Maybe Int
Nothing -> ([[[Sound8]]] -> [[Double]]) -> t
g2 (\[[[Sound8]]]
_ -> [[-Double
1.0]])
              x1F :: ([[[Sound8]]] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
x1F [[[Sound8]]] -> [[a]]
f Choices
ch RhythmBasis
rh = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[a]]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\a
_ -> [[[Sound8]]]
tttts)
              xxF :: [Char] -> Choices -> RhythmBasis -> a -> Double
xxF = forall {t}. (([[[Sound8]]] -> [[Double]]) -> t) -> [Char] -> t
wwF2 forall {a} {a}.
Ord a =>
([[[Sound8]]] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
x1F
              wwF :: [Char] -> Choices -> RhythmBasis -> a -> Double
wwF = forall {t}. (([[[Sound8]]] -> [[Double]]) -> t) -> [Char] -> t
wwF2 forall {a} {a}.
Ord a =>
([[[Sound8]]] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
w1F
              {-# INLINE w1F #-}
              {-# INLINE wwF2 #-}
              {-# INLINE x1F #-}
              {-# INLINE xxF #-}
              {-# INLINE wwF #-}
rhythmicitya'Tup 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 [Char]
choice [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs (CF2 Maybe Double
x Maybe Double
y) [Char]
bbs tttt :: ReadyForConstructionUkr
tttt@(FSL [[[Sound8]]]
tttts) =
 case forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice of
  [Char]
"0" -> if [Char]
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"0z",[Char]
"02z",[Char]
"03z",[Char]
"04z"] then 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)
-> ([[[Sound8]]] -> [[Double]])
-> Double
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityKFHTup 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 (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 (case forall a. [a] -> a
last [Char]
choice of {Char
'2' -> Int
2; Char
'3' -> Int
3; Char
'4' -> Int
4; ~Char
rrrrr -> Int
1}) [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) Double
k (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x)
             (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y) ReadyForConstructionUkr
tttt
         else 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)
-> ([[[Sound8]]] -> [[Double]])
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityKHTup 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
           (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 (case forall a. [a] -> a
last [Char]
choice of {Char
'2' -> Int
2; Char
'3' -> Int
3; Char
'4' -> Int
4; ~Char
rrrrr -> Int
1}) [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y) ReadyForConstructionUkr
tttt
  [Char]
"w" -> if
          | (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
>= [Char]
"1" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
<= [Char]
"4" ->
             (case forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice of
              [Char]
"w0" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) 
              [Char]
"w1" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) 
              [Char]
"w2" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) 
              [Char]
"w3" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) 
              [Char]
_ -> \[[[Sound8]]]
_ -> 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs)  ReadyForConstructionUkr
tttt) [[[Sound8]]]
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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
              where w1F :: ([[[Sound8]]] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
w1F [[[Sound8]]] -> [[a]]
f Choices
ch RhythmBasis
rh = forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) Choices
ch RhythmBasis
rh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[a]]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\a
_ -> [[[Sound8]]]
tttts)
                    wwF :: [Char] -> Choices -> RhythmBasis -> a -> Double
wwF [Char]
xs =
                      let n1 :: Maybe Int
n1 = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
xs::Maybe Int in
                        case Maybe Int
n1 of
                         Just Int
n2 -> forall {a} {a}.
Ord a =>
([[[Sound8]]] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
w1F (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
n2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs)
                         Maybe Int
Nothing -> forall {a} {a}.
Ord a =>
([[[Sound8]]] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
w1F (\[[[Sound8]]]
_ -> [[-Double
1.0]])
                    {-# INLINE w1F #-}
                    {-# INLINE wwF #-}
  [Char]
"x" -> if
          | (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
>= [Char]
"1" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
<= [Char]
"4" ->
             (case forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice of
              [Char]
"x0" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) 
              [Char]
"x1" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) 
              [Char]
"x2" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) 
              [Char]
"x3" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) 
              [Char]
_ -> \[[[Sound8]]]
_ -> 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt) [[[Sound8]]]
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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
              where x1F :: ([[[Sound8]]] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
x1F [[[Sound8]]] -> [[a]]
f Choices
ch RhythmBasis
rh = forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) Choices
ch RhythmBasis
rh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[a]]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\a
_ -> [[[Sound8]]]
tttts)
                    xxF :: [Char] -> Choices -> RhythmBasis -> a -> Double
xxF [Char]
xs =
                      let n1 :: Maybe Int
n1 = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
xs::Maybe Int in
                        case Maybe Int
n1 of
                         Just Int
n2 -> forall {a} {a}.
Ord a =>
([[[Sound8]]] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
x1F (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
n2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs)
                         Maybe Int
Nothing -> forall {a} {a}.
Ord a =>
([[[Sound8]]] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
x1F (\[[[Sound8]]]
_ -> [[-Double
1.0]])
                    {-# INLINE x1F #-}
                    {-# INLINE xxF #-}
  [Char]
_ -> if
     | ((forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
>= [Char]
"b" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
<= [Char]
"v") Bool -> Bool -> Bool
|| (forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
>= [Char]
"A" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
<= [Char]
"Z" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]
"G",[Char]
"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
-> [Char]
-> [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> ReadyForConstructionUkr
-> Double
rhythmicityH'Tup 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 [Char]
choice [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs 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)
-> ([[[Sound8]]] -> [[Double]])
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityKHTup 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
        (let ts :: [Char]
ts = forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice in
          case [Char]
ts of { [] -> (\[[[Sound8]]]
_ -> [[-Double
1.0]]) ; [Char]
ks ->
            let q :: Maybe Int
q = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ks::Maybe Int in
              case Maybe Int
q of {Just Int
q' -> Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
q' [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs; ~Maybe Int
Nothing -> (\[[[Sound8]]]
_ -> [[-Double
1.0]]) }})
                (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y) ReadyForConstructionUkr
tttt
rhythmicitya'Tup 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 [Char]
choice [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Coeffs2
CF0 [Char]
bbs tttt :: ReadyForConstructionUkr
tttt@(Str tttts :: [Char]
tttts@(Char
_:[Char]
_))= if
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"c",[Char]
"M",[Char]
"N"] Bool -> Bool -> Bool
|| (forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
>= [Char]
"A" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
<= [Char]
"F") -> let just_probe :: Maybe ParseChRh
just_probe = [Char] -> Maybe ParseChRh
readRhythmicity [Char]
choice in
           (case Maybe ParseChRh
just_probe of
             Just (P1 Choices
ch RhythmBasis
rh Int
n) -> 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 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> [Double]
rhythmicityGTup 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 (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
n [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs)
             Just (P2 PolyChoices
ch PolyRhythmBasis
rh Int
r Int
n) -> (case forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice of
                   [Char]
"A" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"D" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"E" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"F" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"B" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"C" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"M" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"N" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh
                   [Char]
"c" -> forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh) 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> [Double]
rhythmicityGTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
n [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs)
             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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs))  ReadyForConstructionUkr
tttt
 | [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"0" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
drop Int
2 (forall a. Int -> [a] -> [a]
take Int
3 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"y" ->
    let n2 :: Maybe Int
n2 = forall a. Read a => [Char] -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ [Char]
choice)::Maybe Int in
      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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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
          (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 (case Maybe Int
n2 of {Just Int
n3 -> Int
n3; Maybe Int
Nothing -> Int
1}) [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
 | [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"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)
-> ([[[Sound8]]] -> [[Double]])
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicity0FHTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) Double
k ReadyForConstructionUkr
tttt
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"0" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
drop Int
2 (forall a. Int -> [a] -> [a]
take Int
3 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"z" ->
    let n2 :: Maybe Int
n2 = forall a. Read a => [Char] -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ [Char]
choice)::Maybe Int in
      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)
-> ([[[Sound8]]] -> [[Double]])
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicity0FHTup 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
          (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 (case Maybe Int
n2 of {Just Int
n3 -> Int
n3; Maybe Int
Nothing -> Int
1}) [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) Double
k ReadyForConstructionUkr
tttt
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"w" -> if
          | (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
>= [Char]
"1" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
<= [Char]
"4" ->
             (case forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice of
              [Char]
"w0" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) 
              [Char]
"w1" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) 
              [Char]
"w2" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) 
              [Char]
"w3" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) 
              [Char]
_ -> \[Char]
_ -> 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt) [Char]
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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
 | forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"x" -> if
          | (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
>= [Char]
"1" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
<= [Char]
"4" ->
             (case forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice of
              [Char]
"x0" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              [Char]
"x1" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1)
              [Char]
"x2" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1)
              [Char]
"x3" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              [Char]
_ -> \[Char]
_ -> 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt) [Char]
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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
 | Bool
otherwise -> if
    | (forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"b" Bool -> Bool -> Bool
|| ((forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
>= [Char]
"d" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
<= [Char]
"v") Bool -> Bool -> Bool
|| (forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
>= [Char]
"I" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
<= [Char]
"Z"))) Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
>= [Char]
"1" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
<= [Char]
"9" ->
        (case forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice of
          [Char]
"b" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Int
5 Int
1
          [Char]
"d" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF30 Int
5 Int
1
          [Char]
"e" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Int
6 Int
2
          [Char]
"f" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF30 Int
6 Int
2
          [Char]
"g" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Int
5 Int
1
          [Char]
"h" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF20 Int
5 Int
1
          [Char]
"i" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Int
6 Int
2
          [Char]
"j" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF20 Int
6 Int
2
          [Char]
"k" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Int
5 Int
1
          [Char]
"l" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF30 Int
5 Int
1
          [Char]
"m" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Int
6 Int
2
          [Char]
"n" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF30 Int
6 Int
2
          [Char]
"o" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Int
5 Int
1
          [Char]
"p" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF20 Int
5 Int
1
          [Char]
"q" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Int
6 Int
2
          [Char]
"r" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF20 Int
6 Int
2
          [Char]
"I" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Int
5 Int
1
          [Char]
"J" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF30 Int
5 Int
1
          [Char]
"K" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Int
6 Int
2
          [Char]
"L" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF30 Int
6 Int
2
          [Char]
"O" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Int
5 Int
1
          [Char]
"P" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF20 Int
5 Int
1
          [Char]
"Q" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Int
6 Int
2
          [Char]
"R" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF20 Int
6 Int
2
          [Char]
"W" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Int
5 Int
1
          [Char]
"X" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF30 Int
5 Int
1
          [Char]
"Y" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Int
6 Int
2
          [Char]
"Z" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF30 Int
6 Int
2
          [Char]
"U" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Int
5 Int
1
          [Char]
"V" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF20 Int
5 Int
1
          [Char]
"S" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Int
6 Int
2
          [Char]
"T" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF20 Int
6 Int
2
          [Char]
"u" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Int
5 Int
1
          [Char]
"v" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly0 Int
5 Int
1
          [Char]
"s" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Int
6 Int
2
          [Char]
"t" -> forall {t} {t}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly0 Int
6 Int
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [[[Sound8]]]
convFI [Char]
bbs forall a b. (a -> b) -> a -> b
$  [Char]
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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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
       (let ts :: [Char]
ts = forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice in
          case [Char]
ts of { [] -> (\[[[Sound8]]]
_ -> [[-Double
1.0]]) ; [Char]
ks ->
            let q :: Maybe Int
q = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ks::Maybe Int in
              case Maybe Int
q of {Just Int
q' -> Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
q' [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs; ~Maybe Int
Nothing -> (\[[[Sound8]]]
_ -> [[-Double
1.0]]) }}) ReadyForConstructionUkr
tttt
        where h1 :: (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f [Char]
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]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (case [Char]
ts of { [] -> (\[[[Sound8]]]
_ -> [[-Double
1.0]]) ; [Char]
ks -> let q :: Maybe Int
q = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ks::Maybe Int in
                      case Maybe Int
q of {Just Int
q' -> Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
q' [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs; ~Maybe Int
Nothing -> (\[[[Sound8]]]
_ -> [[-Double
1.0]]) }})
              h2 :: (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f [Char]
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]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (case [Char]
ts of { [] -> (\[[[Sound8]]]
_ -> [[-Double
1.0]]) ; [Char]
ks -> let q :: Maybe Int
q = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ks::Maybe Int in
                      case Maybe Int
q of {Just Int
q' -> Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
q' [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs; ~Maybe Int
Nothing -> (\[[[Sound8]]]
_ -> [[-Double
1.0]]) }})
              g :: (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> [[[Sound8]]] -> Double
g t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"0" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
True,Bool
True] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"1" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
True,Bool
False] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"2" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
False,Bool
True] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"3" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
False,Bool
False] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"4" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
True,Bool
True] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"5" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
True,Bool
False] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"6" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
False,Bool
True] Int
m Int
n
                | forall a. Int -> [a] -> [a]
drop Int
1 (forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice) forall a. Eq a => a -> a -> Bool
== [Char]
"7" = forall {t} {t} {c}.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> [Char] -> [Bool] -> Int -> Int -> [[[Sound8]]] -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) [Bool
True,Bool
False,Bool
False] Int
m Int
n
                | Bool
otherwise = \[[[Sound8]]]
_ -> 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
n [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
              w1F :: ([Char] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
w1F [Char] -> [[a]]
f Choices
ch RhythmBasis
rh = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[a]]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\a
_ -> [Char]
tttts)
              wwF2 :: (([Char] -> [[Double]]) -> t) -> [Char] -> t
wwF2 ([Char] -> [[Double]]) -> t
g2 [Char]
xs =
                let n1 :: Maybe Int
n1 = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
xs::Maybe Int in
                   case Maybe Int
n1 of
                     Just Int
n2 -> ([Char] -> [[Double]]) -> t
g2 (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
n2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [[[Sound8]]]
convFI [Char]
bbs)
                     Maybe Int
Nothing -> ([Char] -> [[Double]]) -> t
g2 (\[Char]
_ -> [[-Double
1.0]])
              x1F :: ([Char] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
x1F [Char] -> [[a]]
f Choices
ch RhythmBasis
rh = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[a]]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\a
_ -> [Char]
tttts)
              xxF :: [Char] -> Choices -> RhythmBasis -> a -> Double
xxF = forall {t}. (([Char] -> [[Double]]) -> t) -> [Char] -> t
wwF2 forall {a} {a}.
Ord a =>
([Char] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
x1F
              wwF :: [Char] -> Choices -> RhythmBasis -> a -> Double
wwF = forall {t}. (([Char] -> [[Double]]) -> t) -> [Char] -> t
wwF2 forall {a} {a}.
Ord a =>
([Char] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
w1F
              {-# INLINE w1F #-}
              {-# INLINE wwF2 #-}
              {-# INLINE x1F #-}
              {-# INLINE xxF #-}
              {-# INLINE wwF #-}
rhythmicitya'Tup 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 [Char]
choice [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs (CF2 Maybe Double
x Maybe Double
y) [Char]
bbs tttt :: ReadyForConstructionUkr
tttt@(Str tttts :: [Char]
tttts@(Char
_:[Char]
_)) =
 case forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice of
  [Char]
"0" -> if [Char]
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"0z",[Char]
"02z",[Char]
"03z",[Char]
"04z"] then 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)
-> ([[[Sound8]]] -> [[Double]])
-> Double
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityKFHTup 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 (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 (case forall a. [a] -> a
last [Char]
choice of {Char
'2' -> Int
2; Char
'3' -> Int
3; Char
'4' -> Int
4; ~Char
rrrrr -> Int
1}) [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) Double
k (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x)
             (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y) ReadyForConstructionUkr
tttt
         else 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)
-> ([[[Sound8]]] -> [[Double]])
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityKHTup 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
           (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 (case forall a. [a] -> a
last [Char]
choice of {Char
'2' -> Int
2; Char
'3' -> Int
3; Char
'4' -> Int
4; ~Char
rrrrr -> Int
1}) [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y) ReadyForConstructionUkr
tttt
  [Char]
"w" -> if
          | (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
>= [Char]
"1" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
<= [Char]
"4" ->
             (case forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice of
              [Char]
"w0" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) 
              [Char]
"w1" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) 
              [Char]
"w2" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) 
              [Char]
"w3" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
wwF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) 
              [Char]
_ -> \[Char]
_ -> 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs)  ReadyForConstructionUkr
tttt) [Char]
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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
              where w1F :: ([Char] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
w1F [Char] -> [[a]]
f Choices
ch RhythmBasis
rh = forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) Choices
ch RhythmBasis
rh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[a]]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\a
_ -> [Char]
tttts)
                    wwF :: [Char] -> Choices -> RhythmBasis -> a -> Double
wwF [Char]
xs =
                      let n1 :: Maybe Int
n1 = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
xs::Maybe Int in
                        case Maybe Int
n1 of
                         Just Int
n2 -> forall {a} {a}.
Ord a =>
([Char] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
w1F (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
n2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [[[Sound8]]]
convFI [Char]
bbs) 
                         Maybe Int
Nothing -> forall {a} {a}.
Ord a =>
([Char] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
w1F (\[Char]
_ -> [[-Double
1.0]])
                    {-# INLINE w1F #-}
                    {-# INLINE wwF #-}
  [Char]
"x" -> if
          | (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
>= [Char]
"1" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) forall a. Ord a => a -> a -> Bool
<= [Char]
"4" ->
             (case forall a. Int -> [a] -> [a]
take Int
2 [Char]
choice of
              [Char]
"x0" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) 
              [Char]
"x1" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) 
              [Char]
"x2" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) 
              [Char]
"x3" -> forall {a}. [Char] -> Choices -> RhythmBasis -> a -> Double
xxF (forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) 
              [Char]
_ -> \[Char]
_ -> 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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt) [Char]
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)
-> ([[[Sound8]]] -> [[Double]])
-> ReadyForConstructionUkr
-> Double
rhythmicity0HTup 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  (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
1 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs) ReadyForConstructionUkr
tttt
              where x1F :: ([Char] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
x1F [Char] -> [[a]]
f Choices
ch RhythmBasis
rh = forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) Choices
ch RhythmBasis
rh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[a]]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\a
_ -> [Char]
tttts)
                    xxF :: [Char] -> Choices -> RhythmBasis -> a -> Double
xxF [Char]
xs =
                      let n1 :: Maybe Int
n1 = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
xs::Maybe Int in
                        case Maybe Int
n1 of
                         Just Int
n2 -> forall {a} {a}.
Ord a =>
([Char] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
x1F (Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
n2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [[[Sound8]]]
convFI [Char]
bbs)
                         Maybe Int
Nothing -> forall {a} {a}.
Ord a =>
([Char] -> [[a]]) -> Choices -> RhythmBasis -> a -> Double
x1F (\[Char]
_ -> [[-Double
1.0]])
                    {-# INLINE x1F #-}
                    {-# INLINE xxF #-}
  [Char]
_ -> if
     | ((forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
>= [Char]
"b" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
<= [Char]
"v") Bool -> Bool -> Bool
|| (forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
>= [Char]
"A" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall a. Ord a => a -> a -> Bool
<= [Char]
"Z" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 [Char]
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]
"G",[Char]
"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
-> [Char]
-> [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> ReadyForConstructionUkr
-> Double
rhythmicityH'Tup 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 [Char]
choice [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs 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)
-> ([[[Sound8]]] -> [[Double]])
-> Double
-> Double
-> ReadyForConstructionUkr
-> Double
rhythmicityKHTup 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
        (let ts :: [Char]
ts = forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Char]
choice in
          case [Char]
ts of { [] -> (\[[[Sound8]]]
_ -> [[-Double
1.0]]) ; [Char]
ks ->
            let q :: Maybe Int
q = forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ks::Maybe Int in
              case Maybe Int
q of {Just Int
q' -> Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]]
helperHF1 Int
q' [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs; ~Maybe Int
Nothing -> (\[[[Sound8]]]
_ -> [[-Double
1.0]]) }})
                (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y) ReadyForConstructionUkr
tttt

rhythmicitya'Tup 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
_ [Char]
_ [[[[Sound8]]] -> [[Double]]]
_ Coeffs2
_ [Char]
_ ReadyForConstructionUkr
_ = -Double
2.0