\begin{code}
-- | 
-- Maintainer : silva.samuel@alumni.uminho.pt
-- Stability  : experimental
-- Portability: portable
-- This module implements Rhythm Motive
module Music.Analysis.Abstract.Rhythm where
import Music.Analysis.PF ((><), swap, p2, split, p1, grd, (-|-), assocl,
    mapL, cataL, e2m, hyloL)
import Music.Analysis.Abstract.Settings (Settings, getNumber, changeText, 
    fromList, number, priority)
import Music.Analysis.Abstract.Motive (Motive, fromMotive, toMotive,
    mapMotive, cataMotive)
import Music.Analysis.Base (Number, Delta, Text, 
    IntegerNumber, RatioNumber, toRatio, toInteger)
import Data.Maybe (maybe)
import Data.Function (id, const, (.))
import Data.Ord (Ord(..))
import Data.Eq (Eq(..))
import Data.Tuple (uncurry)
import Data.List ((++), zip, tail, init, unzip)
import Prelude (Num(..), (/), Show(..),(^), read) 
\end{code}

RhythmNode is defined as pair of Delta, variation on durations, and number of
dots.
Mandatory settings are:
\begin{description}
\item[TempoPitch] by default is number 4,
\item[TempoNumber] by default is number 60,
\item[CompassUp] by default is number 4
\item[CompassDown] by default is number 4.
\end{description}
\begin{code}
-- * Types
-- | Rhythm node
type RhythmNode = (Delta, Dots)
--type RhythmAbsolute = (Number, Dots)
--type RhythmRelative = (Delta, Dots)
type RhythmAbsolute = (RatioNumber, Dots)
type RhythmRelative = (RatioNumber, Dots)
-- | Dots is defined by number.
-- Only Integers and positive numbers are allowed.
type Dots = IntegerNumber
type Duration = Number
data DurationClass = Whole 
                   | Half 
                   | Quarter 
                   | Eighth 
                   | Th16
                   | Th32 
                   | Th64 
                   | UnkownDuration Text
    deriving (Eq, Show)
-- | sefault settings
settings :: Settings
settings = fromList [
                ("TempoPitch",  number 4    priority),
                ("TempoNumber", number 60   priority),
                ("CompassUp",   number 4    priority),
                ("CompassDown", number 4    priority)]
\end{code}


\begin{code}
-- * Auxiliary functions
-- | computes duration /PW/
durationNode :: RhythmNode -> Number
durationNode = 
    hyloL 
        (maybe 0 (uncurry (+))) 
        (e2m . (const () -|- split p1 ((/2) >< pred)) . grd ((<=0).p2)) .
      (id >< succ)
        where pred x = x - 1
              succ x = x + 1    
-- | computes compass duration
compass :: (Number,Number) -> Number
compass (x,y) = x/y
\end{code}

These functions are combinators over Rhythm. 
\begin{code}
-- | changes duration
tempo :: RatioNumber -> Motive RhythmAbsolute -> Motive RhythmAbsolute
tempo n = mapMotive (const ((*n) >< id))
-- | computes duration
duration :: Motive RhythmNode -> Number
duration = p2 . 
    cataMotive 0 (const (uncurry (+) . (durationNode >< id)))
-- | reverse
reverse :: Motive RhythmNode -> Motive RhythmNode
reverse = toMotive . 
    cataMotive [] (const (uncurry (++) . swap . ( (:[]) >< id)))
-- | symmetric trsnformation
symmetric :: RatioNumber -> Motive RhythmAbsolute -> Motive RhythmAbsolute
symmetric n = mapMotive (const ((n +) . (/n) >< id))
\end{code}

Relative function assume that Motive have Absolute Type, and change it into
Relative Type. 
Absolute function is computed using Point-Free approach. Actually, it built
initial lists from nodes and reverse reversed result, summing it. 
Attention: Relative and absolute functions use wrong initial number from
settings.
\begin{code}
-- | Computes relative Rhythm
relative :: Motive RhythmAbsolute -> Motive RhythmRelative
relative = toMotive .
    split (changeText "Type" "Relative" . p1)
        (mapL (split (uncurry (/) . (p1 >< p1)) (p2 . p1)) .
        uncurry zip . (p2 >< uncurry (:) . (initial >< id)) .
        split id id . 
        (maybe (toRatio 4) (toRatio . toInteger) . 
            getNumber "CompassDown" >< id))
    . fromMotive 
    where initial :: RatioNumber -> RhythmAbsolute
          initial = split id (const 0)
-- | Absolute PF
absolute :: Motive RhythmRelative -> Motive RhythmAbsolute
absolute = toMotive .
    split (changeText "Type" "Absolute" . p1) 
        (uncurry zip . (tail . 
            (mapL (cataL (maybe (toRatio 1) (uncurry (*))))) . 
            (hyloL (maybe [] (uncurry (++) . swap . ((:[]) >< id))) 
                   (e2m . ( const () -|- split id init) . grd (==[]))) .
            (uncurry (:)) 
            >< id) .
        (assocl . (id >< unzip)) .
        (maybe (toRatio 4) (toRatio.toInteger) . getNumber "CompassDown" >< id))
     . fromMotive
\end{code}


\begin{code}
durationNumber :: DurationClass -> Duration
durationNumber Whole = 4
durationNumber Half  = 2
durationNumber Quarter = 1
durationNumber Eighth = 0.5
durationNumber Th16  = 0.25
durationNumber Th32  = 0.125
durationNumber Th64  = 0.0625
durationNumber (UnkownDuration _) = 1
\end{code}

\begin{code}
-- |
durationTotalNumber :: (DurationClass, Dots) -> Duration
durationTotalNumber =
    hyloL 
        (maybe 0 (uncurry (+))) 
        (e2m . (const () -|- split p1 ((/2) >< pred)) . grd ((<=0).p2)) .
      (durationNumber >< succ)
        where pred x = x - 1
              succ x = x + 1 
-- |
getDurationClass :: (Duration,Dots) -> DurationClass
getDurationClass (4,_) = Whole
getDurationClass (2,_) = Half
getDurationClass (1,_) = Quarter
getDurationClass (0.5,_) = Eighth
getDurationClass (0.25,_) = Th16
getDurationClass (0.125,_) = Th32
getDurationClass (0.0625,_) = Th64
getDurationClass (b,0) = UnkownDuration (show b)
getDurationClass (t,i) = getDurationClass (((2^i) / ((2^(i+1)) - 1)) * t, 0)
-- |
getDuration :: (DurationClass, Dots) -> Duration
getDuration =
    hyloL 
        (maybe 0 (uncurry (+))) 
        (e2m . (const () -|- split p1 ((/2) >< pred)) . grd ((<=0).p2)) .
      (durationNumber >< succ)
        where pred x = x - 1
              succ x = x + 1 
-- |
getDuration_aux1 :: DurationClass -> Duration
getDuration_aux1 Whole = 4
getDuration_aux1 Half = 2
getDuration_aux1 Quarter = 1
getDuration_aux1 Eighth = 0.5
getDuration_aux1 Th16 = 0.25
getDuration_aux1 Th32 = 0.125
getDuration_aux1 Th64 = 0.0625
getDuration_aux1 (UnkownDuration x) = read x
\end{code}