-- | Common music notation dynamic marks.
module Music.Theory.Dynamic_Mark where

import Data.Char {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}
import Text.Read {- base -}

import qualified Music.Theory.List as T {- hmt -}

-- | Enumeration of dynamic mark symbols.
data Dynamic_Mark = Niente
                    | Ppppp | Pppp | Ppp | Pp | P | Mp
                    | Mf | F | Ff | Fff | Ffff | Fffff
                    | Fp | Sf | Sfp | Sfpp | Sfz | Sffz
                      deriving (Dynamic_Mark -> Dynamic_Mark -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dynamic_Mark -> Dynamic_Mark -> Bool
$c/= :: Dynamic_Mark -> Dynamic_Mark -> Bool
== :: Dynamic_Mark -> Dynamic_Mark -> Bool
$c== :: Dynamic_Mark -> Dynamic_Mark -> Bool
Eq,Eq Dynamic_Mark
Dynamic_Mark -> Dynamic_Mark -> Bool
Dynamic_Mark -> Dynamic_Mark -> Ordering
Dynamic_Mark -> Dynamic_Mark -> Dynamic_Mark
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Dynamic_Mark -> Dynamic_Mark -> Dynamic_Mark
$cmin :: Dynamic_Mark -> Dynamic_Mark -> Dynamic_Mark
max :: Dynamic_Mark -> Dynamic_Mark -> Dynamic_Mark
$cmax :: Dynamic_Mark -> Dynamic_Mark -> Dynamic_Mark
>= :: Dynamic_Mark -> Dynamic_Mark -> Bool
$c>= :: Dynamic_Mark -> Dynamic_Mark -> Bool
> :: Dynamic_Mark -> Dynamic_Mark -> Bool
$c> :: Dynamic_Mark -> Dynamic_Mark -> Bool
<= :: Dynamic_Mark -> Dynamic_Mark -> Bool
$c<= :: Dynamic_Mark -> Dynamic_Mark -> Bool
< :: Dynamic_Mark -> Dynamic_Mark -> Bool
$c< :: Dynamic_Mark -> Dynamic_Mark -> Bool
compare :: Dynamic_Mark -> Dynamic_Mark -> Ordering
$ccompare :: Dynamic_Mark -> Dynamic_Mark -> Ordering
Ord,Int -> Dynamic_Mark
Dynamic_Mark -> Int
Dynamic_Mark -> [Dynamic_Mark]
Dynamic_Mark -> Dynamic_Mark
Dynamic_Mark -> Dynamic_Mark -> [Dynamic_Mark]
Dynamic_Mark -> Dynamic_Mark -> Dynamic_Mark -> [Dynamic_Mark]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Dynamic_Mark -> Dynamic_Mark -> Dynamic_Mark -> [Dynamic_Mark]
$cenumFromThenTo :: Dynamic_Mark -> Dynamic_Mark -> Dynamic_Mark -> [Dynamic_Mark]
enumFromTo :: Dynamic_Mark -> Dynamic_Mark -> [Dynamic_Mark]
$cenumFromTo :: Dynamic_Mark -> Dynamic_Mark -> [Dynamic_Mark]
enumFromThen :: Dynamic_Mark -> Dynamic_Mark -> [Dynamic_Mark]
$cenumFromThen :: Dynamic_Mark -> Dynamic_Mark -> [Dynamic_Mark]
enumFrom :: Dynamic_Mark -> [Dynamic_Mark]
$cenumFrom :: Dynamic_Mark -> [Dynamic_Mark]
fromEnum :: Dynamic_Mark -> Int
$cfromEnum :: Dynamic_Mark -> Int
toEnum :: Int -> Dynamic_Mark
$ctoEnum :: Int -> Dynamic_Mark
pred :: Dynamic_Mark -> Dynamic_Mark
$cpred :: Dynamic_Mark -> Dynamic_Mark
succ :: Dynamic_Mark -> Dynamic_Mark
$csucc :: Dynamic_Mark -> Dynamic_Mark
Enum,Dynamic_Mark
forall a. a -> a -> Bounded a
maxBound :: Dynamic_Mark
$cmaxBound :: Dynamic_Mark
minBound :: Dynamic_Mark
$cminBound :: Dynamic_Mark
Bounded,Int -> Dynamic_Mark -> ShowS
[Dynamic_Mark] -> ShowS
Dynamic_Mark -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dynamic_Mark] -> ShowS
$cshowList :: [Dynamic_Mark] -> ShowS
show :: Dynamic_Mark -> String
$cshow :: Dynamic_Mark -> String
showsPrec :: Int -> Dynamic_Mark -> ShowS
$cshowsPrec :: Int -> Dynamic_Mark -> ShowS
Show,ReadPrec [Dynamic_Mark]
ReadPrec Dynamic_Mark
Int -> ReadS Dynamic_Mark
ReadS [Dynamic_Mark]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Dynamic_Mark]
$creadListPrec :: ReadPrec [Dynamic_Mark]
readPrec :: ReadPrec Dynamic_Mark
$creadPrec :: ReadPrec Dynamic_Mark
readList :: ReadS [Dynamic_Mark]
$creadList :: ReadS [Dynamic_Mark]
readsPrec :: Int -> ReadS Dynamic_Mark
$creadsPrec :: Int -> ReadS Dynamic_Mark
Read)

{- | Case insensitive reader for 'Dynamic_Mark'.

> map dynamic_mark_t_parse_ci (words "pP p Mp F")
-}
dynamic_mark_t_parse_ci :: String -> Maybe Dynamic_Mark
dynamic_mark_t_parse_ci :: String -> Maybe Dynamic_Mark
dynamic_mark_t_parse_ci =
  let capitalise :: ShowS
capitalise String
x = Char -> Char
toUpper (forall a. [a] -> a
head String
x) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (forall a. [a] -> [a]
tail String
x)
  in forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
capitalise

{- | Lookup Midi velocity for 'Dynamic_Mark'.  The range is linear in @0-127@.

> let r = [0,6,17,28,39,50,61,72,83,94,105,116,127]
> mapMaybe dynamic_mark_midi [Niente .. Fffff] == r

> mapMaybe dynamic_mark_midi [Pp .. Ff] == [39,50,61,72,83,94]

> map dynamic_mark_midi [Fp,Sf,Sfp,Sfpp,Sfz,Sffz] == replicate 6 Nothing
-}
dynamic_mark_midi :: (Num n,Enum n) => Dynamic_Mark -> Maybe n
dynamic_mark_midi :: forall n. (Num n, Enum n) => Dynamic_Mark -> Maybe n
dynamic_mark_midi Dynamic_Mark
m =
    let r :: [(Int, n)]
r = forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (n
0 forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
reverse [n
127, n
127forall a. Num a => a -> a -> a
-n
11 .. n
0])
    in forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall a. Enum a => a -> Int
fromEnum Dynamic_Mark
m) [(Int, n)]
r

-- | Error variant.
dynamic_mark_midi_err :: Integral n => Dynamic_Mark -> n
dynamic_mark_midi_err :: forall n. Integral n => Dynamic_Mark -> n
dynamic_mark_midi_err = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"dynamic_mark_midi") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. (Num n, Enum n) => Dynamic_Mark -> Maybe n
dynamic_mark_midi

{- | Map midi velocity (0-127) to dynamic mark.

> histogram (mapMaybe midi_dynamic_mark [0 .. 127])
-}
midi_dynamic_mark :: (Ord n,Num n,Enum n) => n -> Maybe Dynamic_Mark
midi_dynamic_mark :: forall n. (Ord n, Num n, Enum n) => n -> Maybe Dynamic_Mark
midi_dynamic_mark n
m =
    let r :: [(n, Int)]
r = forall a b. [a] -> [b] -> [(a, b)]
zip (n
0 forall a. a -> [a] -> [a]
: [n
12,n
24 .. n
132]) [Int
0..]
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Ord a => a -> a -> Bool
>= n
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(n, Int)]
r)

{- | Translate /fixed/ 'Dynamic_Mark's to /db/ amplitude over given /range/.

> mapMaybe (dynamic_mark_db 120) [Niente,P,F,Fffff] == [-120,-70,-40,0]
> mapMaybe (dynamic_mark_db 60) [Niente,P,F,Fffff] == [-60,-35,-20,0]
-}
dynamic_mark_db :: Fractional n => n -> Dynamic_Mark -> Maybe n
dynamic_mark_db :: forall n. Fractional n => n -> Dynamic_Mark -> Maybe n
dynamic_mark_db n
r Dynamic_Mark
m =
    let u :: [Dynamic_Mark]
u = [Dynamic_Mark
Niente .. Dynamic_Mark
Fffff]
        n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Dynamic_Mark]
u forall a. Num a => a -> a -> a
- Int
1
        k :: n
k = n
r forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        f :: a -> n
f a
i = forall a. Num a => a -> a
negate n
r forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i forall a. Num a => a -> a -> a
* n
k)
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. Integral a => a -> n
f (forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Dynamic_Mark
m [Dynamic_Mark]
u)

{- | <http://www.csounds.com/manual/html/ampmidid.html>

> import Sound.Sc3.Plot {- hsc3-plot -}
> plot_p1_ln [map (ampmidid 20) [0 .. 127],map (ampmidid 60) [0 .. 127]]
-}
ampmidid :: Floating a => a -> a -> a
ampmidid :: forall a. Floating a => a -> a -> a
ampmidid a
db a
v =
    let r :: a
r = a
10 forall a. Floating a => a -> a -> a
** (a
db forall a. Fractional a => a -> a -> a
/ a
20)
        b :: a
b = a
127 forall a. Fractional a => a -> a -> a
/ (a
126 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sqrt a
r) forall a. Num a => a -> a -> a
- a
1 forall a. Fractional a => a -> a -> a
/ a
126
        m :: a
m = (a
1 forall a. Num a => a -> a -> a
- a
b) forall a. Fractional a => a -> a -> a
/ a
127
    in (a
m forall a. Num a => a -> a -> a
* a
v forall a. Num a => a -> a -> a
+ a
b) forall a. Floating a => a -> a -> a
** a
2

{- | JMcC (Sc3) equation.

> plot_p1_ln [map amp_db [0,0.005 .. 1]]
-}
amp_db :: Floating a => a -> a
amp_db :: forall a. Floating a => a -> a
amp_db a
a = forall a. Floating a => a -> a -> a
logBase a
10 a
a forall a. Num a => a -> a -> a
* a
20

{- | JMcC (Sc3) equation.

> plot_p1_ln [map db_amp [-60,-59 .. 0]]
-}
db_amp :: Floating a => a -> a
db_amp :: forall a. Floating a => a -> a
db_amp a
a = a
10 forall a. Floating a => a -> a -> a
** (a
a forall a. Num a => a -> a -> a
* a
0.05)

-- | Enumeration of hairpin indicators.
data Hairpin = Crescendo | Diminuendo | End_Hairpin
                 deriving (Hairpin -> Hairpin -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hairpin -> Hairpin -> Bool
$c/= :: Hairpin -> Hairpin -> Bool
== :: Hairpin -> Hairpin -> Bool
$c== :: Hairpin -> Hairpin -> Bool
Eq,Eq Hairpin
Hairpin -> Hairpin -> Bool
Hairpin -> Hairpin -> Ordering
Hairpin -> Hairpin -> Hairpin
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Hairpin -> Hairpin -> Hairpin
$cmin :: Hairpin -> Hairpin -> Hairpin
max :: Hairpin -> Hairpin -> Hairpin
$cmax :: Hairpin -> Hairpin -> Hairpin
>= :: Hairpin -> Hairpin -> Bool
$c>= :: Hairpin -> Hairpin -> Bool
> :: Hairpin -> Hairpin -> Bool
$c> :: Hairpin -> Hairpin -> Bool
<= :: Hairpin -> Hairpin -> Bool
$c<= :: Hairpin -> Hairpin -> Bool
< :: Hairpin -> Hairpin -> Bool
$c< :: Hairpin -> Hairpin -> Bool
compare :: Hairpin -> Hairpin -> Ordering
$ccompare :: Hairpin -> Hairpin -> Ordering
Ord,Int -> Hairpin
Hairpin -> Int
Hairpin -> [Hairpin]
Hairpin -> Hairpin
Hairpin -> Hairpin -> [Hairpin]
Hairpin -> Hairpin -> Hairpin -> [Hairpin]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Hairpin -> Hairpin -> Hairpin -> [Hairpin]
$cenumFromThenTo :: Hairpin -> Hairpin -> Hairpin -> [Hairpin]
enumFromTo :: Hairpin -> Hairpin -> [Hairpin]
$cenumFromTo :: Hairpin -> Hairpin -> [Hairpin]
enumFromThen :: Hairpin -> Hairpin -> [Hairpin]
$cenumFromThen :: Hairpin -> Hairpin -> [Hairpin]
enumFrom :: Hairpin -> [Hairpin]
$cenumFrom :: Hairpin -> [Hairpin]
fromEnum :: Hairpin -> Int
$cfromEnum :: Hairpin -> Int
toEnum :: Int -> Hairpin
$ctoEnum :: Int -> Hairpin
pred :: Hairpin -> Hairpin
$cpred :: Hairpin -> Hairpin
succ :: Hairpin -> Hairpin
$csucc :: Hairpin -> Hairpin
Enum,Hairpin
forall a. a -> a -> Bounded a
maxBound :: Hairpin
$cmaxBound :: Hairpin
minBound :: Hairpin
$cminBound :: Hairpin
Bounded,Int -> Hairpin -> ShowS
[Hairpin] -> ShowS
Hairpin -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hairpin] -> ShowS
$cshowList :: [Hairpin] -> ShowS
show :: Hairpin -> String
$cshow :: Hairpin -> String
showsPrec :: Int -> Hairpin -> ShowS
$cshowsPrec :: Int -> Hairpin -> ShowS
Show)

{- | The 'Hairpin' implied by a ordered pair of 'Dynamic_Mark's.

> map (implied_hairpin Mf) [Mp,F] == [Just Diminuendo,Just Crescendo]
-}
implied_hairpin :: Dynamic_Mark -> Dynamic_Mark -> Maybe Hairpin
implied_hairpin :: Dynamic_Mark -> Dynamic_Mark -> Maybe Hairpin
implied_hairpin Dynamic_Mark
p Dynamic_Mark
q =
    case forall a. Ord a => a -> a -> Ordering
compare Dynamic_Mark
p Dynamic_Mark
q of
      Ordering
LT -> forall a. a -> Maybe a
Just Hairpin
Crescendo
      Ordering
EQ -> forall a. Maybe a
Nothing
      Ordering
GT -> forall a. a -> Maybe a
Just Hairpin
Diminuendo

-- | A node in a dynamic sequence.
type Dynamic_Node = (Maybe Dynamic_Mark,Maybe Hairpin)

-- | The empty 'Dynamic_Node'.
empty_dynamic_node :: Dynamic_Node
empty_dynamic_node :: Dynamic_Node
empty_dynamic_node = (forall a. Maybe a
Nothing,forall a. Maybe a
Nothing)

{- | Calculate a 'Dynamic_Node' sequence from a sequence of 'Dynamic_Mark's.

> let r = [(Just Pp,Just Crescendo), (Just Mp,Just End_Hairpin) ,(Nothing,Just Diminuendo) ,(Just Pp,Just End_Hairpin)]
> dynamic_sequence [Pp,Mp,Mp,Pp] == r
-}
dynamic_sequence :: [Dynamic_Mark] -> [Dynamic_Node]
dynamic_sequence :: [Dynamic_Mark] -> [Dynamic_Node]
dynamic_sequence [Dynamic_Mark]
d =
    let h :: [Maybe Hairpin]
h = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Dynamic_Mark -> Dynamic_Mark -> Maybe Hairpin
implied_hairpin [Dynamic_Mark]
d (forall a. [a] -> [a]
tail [Dynamic_Mark]
d) forall a. [a] -> [a] -> [a]
++ [forall a. Maybe a
Nothing]
        e :: Maybe Hairpin
e = forall a. a -> Maybe a
Just Hairpin
End_Hairpin
        rec :: Bool -> [(a, Maybe Hairpin)] -> [(a, Maybe Hairpin)]
rec Bool
i [(a, Maybe Hairpin)]
p =
            case [(a, Maybe Hairpin)]
p of
              [] -> []
              [(a
j,Maybe Hairpin
_)] -> if Bool
i then [(a
j,Maybe Hairpin
e)] else [(a
j,forall a. Maybe a
Nothing)]
              (a
j,Maybe Hairpin
k):[(a, Maybe Hairpin)]
p' -> case Maybe Hairpin
k of
                            Maybe Hairpin
Nothing -> if Bool
i
                                       then (a
j,Maybe Hairpin
e) forall a. a -> [a] -> [a]
: Bool -> [(a, Maybe Hairpin)] -> [(a, Maybe Hairpin)]
rec Bool
False [(a, Maybe Hairpin)]
p'
                                       else (a
j,Maybe Hairpin
k) forall a. a -> [a] -> [a]
: Bool -> [(a, Maybe Hairpin)] -> [(a, Maybe Hairpin)]
rec Bool
False [(a, Maybe Hairpin)]
p'
                            Just Hairpin
_ -> (a
j,Maybe Hairpin
k) forall a. a -> [a] -> [a]
: Bool -> [(a, Maybe Hairpin)] -> [(a, Maybe Hairpin)]
rec Bool
True [(a, Maybe Hairpin)]
p'
    in forall {a}. Bool -> [(a, Maybe Hairpin)] -> [(a, Maybe Hairpin)]
rec Bool
False (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Eq a => [a] -> [Maybe a]
T.indicate_repetitions [Dynamic_Mark]
d) [Maybe Hairpin]
h)

{- | Delete redundant (unaltered) dynamic marks.

> let r = [Just P,Nothing,Nothing,Nothing,Just F]
> delete_redundant_marks [Just P,Nothing,Just P,Just P,Just F] == r
-}
delete_redundant_marks :: [Maybe Dynamic_Mark] -> [Maybe Dynamic_Mark]
delete_redundant_marks :: [Maybe Dynamic_Mark] -> [Maybe Dynamic_Mark]
delete_redundant_marks =
    let f :: Maybe a -> Maybe a -> (Maybe a, Maybe a)
f Maybe a
i Maybe a
j = case (Maybe a
i,Maybe a
j) of
                  (Just a
a,Just a
b) -> if a
a forall a. Eq a => a -> a -> Bool
== a
b then (Maybe a
j,forall a. Maybe a
Nothing) else (Maybe a
j,Maybe a
j)
                  (Just a
_,Maybe a
Nothing) -> (Maybe a
i,forall a. Maybe a
Nothing)
                  (Maybe a
Nothing,Maybe a
_) -> (Maybe a
j,Maybe a
j)
    in forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL forall {a}. Eq a => Maybe a -> Maybe a -> (Maybe a, Maybe a)
f forall a. Maybe a
Nothing

{- | Variant of 'dynamic_sequence' for sequences of 'Dynamic_Mark' with holes (ie. rests).
Runs 'delete_redundant_marks'.

> let r = [Just (Just P,Just Crescendo),Just (Just F,Just End_Hairpin),Nothing,Just (Just P,Nothing)]
> dynamic_sequence_sets [Just P,Just F,Nothing,Just P] == r

> dynamic_sequence_sets [Just P,Nothing,Just P] == [Just (Just P,Nothing),Nothing,Nothing]
-}
dynamic_sequence_sets :: [Maybe Dynamic_Mark] -> [Maybe Dynamic_Node]
dynamic_sequence_sets :: [Maybe Dynamic_Mark] -> [Maybe Dynamic_Node]
dynamic_sequence_sets =
    let f :: [Maybe Dynamic_Mark] -> [Maybe Dynamic_Node]
f [Maybe Dynamic_Mark]
l = case [Maybe Dynamic_Mark]
l of
                Maybe Dynamic_Mark
Nothing:[Maybe Dynamic_Mark]
_ -> forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) [Maybe Dynamic_Mark]
l
                [Maybe Dynamic_Mark]
_ -> forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just ([Dynamic_Mark] -> [Dynamic_Node]
dynamic_sequence (forall a. [Maybe a] -> [a]
catMaybes [Maybe Dynamic_Mark]
l))
    in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Maybe Dynamic_Mark] -> [Maybe Dynamic_Node]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [[Maybe a]]
T.group_just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Dynamic_Mark] -> [Maybe Dynamic_Mark]
delete_redundant_marks

{- | Apply 'Hairpin' and 'Dynamic_Mark' functions in that order as required by 'Dynamic_Node'.

> let f _ x = show x
> apply_dynamic_node f f (Nothing,Just Crescendo) undefined
-}
apply_dynamic_node :: (a -> Dynamic_Mark -> a) -> (a -> Hairpin -> a) -> Dynamic_Node -> a -> a
apply_dynamic_node :: forall a.
(a -> Dynamic_Mark -> a)
-> (a -> Hairpin -> a) -> Dynamic_Node -> a -> a
apply_dynamic_node a -> Dynamic_Mark -> a
f a -> Hairpin -> a
g (Maybe Dynamic_Mark
i,Maybe Hairpin
j) a
m =
    let n :: a
n = forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
m (a -> Hairpin -> a
g a
m) Maybe Hairpin
j
    in forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
n (a -> Dynamic_Mark -> a
f a
n) Maybe Dynamic_Mark
i

-- * Ascii

-- | Ascii pretty printer for 'Dynamic_Mark'.
dynamic_mark_ascii :: Dynamic_Mark -> String
dynamic_mark_ascii :: Dynamic_Mark -> String
dynamic_mark_ascii = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

-- | Ascii pretty printer for 'Hairpin'.
hairpin_ascii :: Hairpin -> String
hairpin_ascii :: Hairpin -> String
hairpin_ascii Hairpin
hp =
    case Hairpin
hp of
      Hairpin
Crescendo -> String
"<"
      Hairpin
Diminuendo -> String
">"
      Hairpin
End_Hairpin -> String
""

-- | Ascii pretty printer for 'Dynamic_Node'.
dynamic_node_ascii :: Dynamic_Node -> String
dynamic_node_ascii :: Dynamic_Node -> String
dynamic_node_ascii (Maybe Dynamic_Mark
mk,Maybe Hairpin
hp) =
    let mk' :: String
mk' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Dynamic_Mark -> String
dynamic_mark_ascii Maybe Dynamic_Mark
mk
        hp' :: String
hp' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Hairpin -> String
hairpin_ascii Maybe Hairpin
hp
    in case (String
mk',String
hp') of
         ([],[]) -> []
         ([],String
_) -> String
hp'
         (String
_,[]) -> String
mk'
         (String, String)
_ -> String
mk' forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
hp'

-- | Ascii pretty printer for 'Dynamic_Node' sequence.
dynamic_sequence_ascii :: [Dynamic_Node] -> String
dynamic_sequence_ascii :: [Dynamic_Node] -> String
dynamic_sequence_ascii =
    [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall a b. (a -> b) -> [a] -> [b]
map Dynamic_Node -> String
dynamic_node_ascii