Tied.hs

-- | 'Rq' values with /tie right/ qualifier.
module Music.Theory.Duration.Rq.Tied where

import Data.Maybe {- base -}

import Music.Theory.List {- hmt-base -}

import Music.Theory.Duration {- hmt -}
import qualified Music.Theory.Duration.Annotation as Annotation {- hmt -}
import Music.Theory.Duration.Rq {- hmt -}

-- | Boolean.
type Tied_Right = Bool

-- | 'Rq' with /tie right/.
type Rq_Tied = (Rq,Tied_Right)

-- | If Rq_Tied is not tied, get Rq.
rqt_to_rq :: Rq_Tied -> Maybe Rq
rqt_to_rq (rq,x) = if x then Nothing else Just rq

-- | Erroring variant of rqt_to_rq.
rqt_to_rq_err :: Rq_Tied -> Rq
rqt_to_rq_err = fromMaybe (error "rqt_to_rq") . rqt_to_rq

-- | Construct 'Rq_Tied'.
rqt :: Tied_Right -> Rq -> Rq_Tied
rqt t d = (d,t)

-- | 'Rq' field of 'Rq_Tied'.
rqt_rq :: Rq_Tied -> Rq
rqt_rq = fst

-- | 'Tied' field of 'Rq_Tied'.
rqt_tied :: Rq_Tied -> Tied_Right
rqt_tied = snd

-- | Is 'Rq_Tied' tied right.
is_tied_right :: Rq_Tied -> Bool
is_tied_right = snd

-- | 'Rq_Tied' variant of 'rq_un_tuplet'.
--
-- > rqt_un_tuplet (3,2) (1,T) == (3/2,T)
--
-- > let f = rqt_un_tuplet (7,4)
-- > in map f [(2/7,F),(4/7,T),(1/7,F)] == [(1/2,F),(1,T),(1/4,F)]
rqt_un_tuplet :: (Integer,Integer) -> Rq_Tied -> Rq_Tied
rqt_un_tuplet i (d,t) = (rq_un_tuplet i d,t)

-- | Transform 'Rq' to untied 'Rq_Tied'.
--
-- > rq_rqt 3 == (3,F)
rq_rqt :: Rq -> Rq_Tied
rq_rqt n = (n,False)

-- | Tie last element only of list of 'Rq'.
--
-- > rq_tie_last [1,2,3] == [(1,F),(2,F),(3,T)]
rq_tie_last :: [Rq] -> [Rq_Tied]
rq_tie_last = at_last rq_rqt (\d -> (d,True))

-- | Transform a list of 'Rq_Tied' to a list of 'Duration_A'.  The flag
-- indicates if the initial value is tied left.
--
-- > rqt_to_duration_a False [(1,T),(1/4,T),(3/4,F)]
rqt_to_duration_a :: Bool -> [Rq_Tied] -> [Annotation.Duration_A]
rqt_to_duration_a z x =
    let rt = map is_tied_right x
        lt = z : rt
        f p e = if p then Just e else Nothing
        g r l = catMaybes [f r Annotation.Tie_Right,f l Annotation.Tie_Left]
        h = rq_to_duration_err (show ("rqt_to_duration_a",z,x)) 2 . rqt_rq
    in zip (map h x) (zipWith g rt lt)

-- | 'Rq_Tied' variant of 'rq_can_notate'.
rqt_can_notate :: Dots -> [Rq_Tied] -> Bool
rqt_can_notate k = rq_can_notate k  . map rqt_rq

-- | 'Rq_Tied' variant of 'rq_to_cmn'.
--
-- > rqt_to_cmn (5,T) == Just ((4,T),(1,T))
-- > rqt_to_cmn (5/4,T) == Just ((1,T),(1/4,T))
-- > rqt_to_cmn (5/7,F) == Just ((4/7,T),(1/7,F))
rqt_to_cmn :: Rq_Tied -> Maybe (Rq_Tied,Rq_Tied)
rqt_to_cmn (k,t) =
    let f (i,j) = ((i,True),(j,t))
    in fmap f (rq_to_cmn k)

-- | List variant of 'rqt_to_cmn'.
--
-- > rqt_to_cmn_l (5,T) == [(4,T),(1,T)]
rqt_to_cmn_l :: Rq_Tied -> [Rq_Tied]
rqt_to_cmn_l x = maybe [x] (\(i,j) -> [i,j]) (rqt_to_cmn x)

-- | 'concatMap' 'rqt_to_cmn_l'.
--
-- > rqt_set_to_cmn [(1,T),(5/4,F)] == [(1,T),(1,T),(1/4,F)]
-- > rqt_set_to_cmn [(1/5,True),(1/20,False),(1/2,False),(1/4,True)]
rqt_set_to_cmn :: [Rq_Tied] -> [Rq_Tied]
rqt_set_to_cmn = concatMap rqt_to_cmn_l