{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK show-extensions #-}

{- |
Module      :  Aftovolio.Coeffs
Copyright   :  (c) OleksandrZhabenko 2020-2024
License     :  MIT
Stability   :  Experimental
Maintainer  :  oleksandr.zhabenko@yahoo.com

The coefficients functionality common for both phonetic-languages-simplified-examples-array and phonetic-languages-simplified-generalized-examples-array lines of AFTOVolio.
-}
module Aftovolio.Coeffs (
    -- * Newtype to work with
    CoeffTwo (..),
    Coeffs2,
    isEmpty,
    isPair,
    fstCF,
    sndCF,
    readCF,
) where

import Data.Maybe (fromJust, fromMaybe, isNothing)
import GHC.Base
import GHC.List
import Text.Read (readMaybe)

data CoeffTwo a = CF0 | CF2 (Maybe a) (Maybe a) deriving (CoeffTwo a -> CoeffTwo a -> Bool
(CoeffTwo a -> CoeffTwo a -> Bool)
-> (CoeffTwo a -> CoeffTwo a -> Bool) -> Eq (CoeffTwo a)
forall a. Eq a => CoeffTwo a -> CoeffTwo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => CoeffTwo a -> CoeffTwo a -> Bool
== :: CoeffTwo a -> CoeffTwo a -> Bool
$c/= :: forall a. Eq a => CoeffTwo a -> CoeffTwo a -> Bool
/= :: CoeffTwo a -> CoeffTwo a -> Bool
Eq)

isEmpty :: CoeffTwo a -> Bool
isEmpty :: forall a. CoeffTwo a -> Bool
isEmpty CoeffTwo a
CF0 = Bool
True
isEmpty CoeffTwo a
_ = Bool
False

isPair :: CoeffTwo a -> Bool
isPair :: forall a. CoeffTwo a -> Bool
isPair CoeffTwo a
CF0 = Bool
False
isPair CoeffTwo a
_ = Bool
True

fstCF :: CoeffTwo a -> Maybe a
fstCF :: forall a. CoeffTwo a -> Maybe a
fstCF (CF2 Maybe a
x Maybe a
_) = Maybe a
x
fstCF CoeffTwo a
_ = Maybe a
forall a. Maybe a
Nothing

sndCF :: CoeffTwo a -> Maybe a
sndCF :: forall a. CoeffTwo a -> Maybe a
sndCF (CF2 Maybe a
_ Maybe a
y) = Maybe a
y
sndCF CoeffTwo a
_ = Maybe a
forall a. Maybe a
Nothing

readCF :: String -> Coeffs2
readCF :: String -> Coeffs2
readCF String
xs
    | (Char -> Bool) -> String -> Bool
forall a. (a -> Bool) -> [a] -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') String
xs =
        let (!Maybe Double
ys, !Maybe Double
zs) =
                (\(String
ks, String
ts) -> (String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe String
ks :: Maybe Double, String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
ts) :: Maybe Double))
                    ((String, String) -> (Maybe Double, Maybe Double))
-> (String -> (String, String))
-> String
-> (Maybe Double, Maybe Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') (String -> (Maybe Double, Maybe Double))
-> String -> (Maybe Double, Maybe Double)
forall a b. (a -> b) -> a -> b
$
                    String
xs
         in if (Maybe Double -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Double
ys Bool -> Bool -> Bool
&& Maybe Double -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Double
zs) then Coeffs2
forall a. CoeffTwo a
CF0 else Maybe Double -> Maybe Double -> Coeffs2
forall a. Maybe a -> Maybe a -> CoeffTwo a
CF2 Maybe Double
ys Maybe Double
zs
    | Bool
otherwise = Coeffs2
forall a. CoeffTwo a
CF0

-- | A data type that is used to represent the coefficients of the rhythmicity functions as a one argument value.
type Coeffs2 = CoeffTwo Double