-- | KeyKit phrase literal (constant) parser and printer.
module Music.Theory.Time.KeyKit.Parser where

import Data.Maybe {- base -}
import Text.Printf {- base -}

import qualified Text.Parsec as P {- parsec -}
import qualified Text.Parsec.String as String {- parsec -}

-- * Parser setup

-- | A 'Char' parser with no user state.
type P a = String.GenParser Char () a

-- | Run parser and return either an error string or an answer.
kk_parse_either :: P t -> String -> Either String t
kk_parse_either :: forall t. P t -> String -> Either String t
kk_parse_either P t
p = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ParseError
m -> forall a b. a -> Either a b
Left (String
"kk_parse: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ParseError
m)) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse P t
p String
""

-- | Run parser and report any error.  Does not delete leading spaces.
kk_parse :: P t -> String -> t
kk_parse :: forall t. P t -> String -> t
kk_parse P t
p = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
e -> forall a. HasCallStack => String -> a
error String
e) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. P t -> String -> Either String t
kk_parse_either P t
p

-- | Run p then q, returning result of p.
(>>~) :: Monad m => m t -> m u -> m t
m t
p >>~ :: forall (m :: * -> *) t u. Monad m => m t -> m u -> m t
>>~ m u
q = m t
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t
x -> m u
q forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return t
x

kk_lexeme :: P t -> P t
kk_lexeme :: forall t. P t -> P t
kk_lexeme P t
p = P t
p forall (m :: * -> *) t u. Monad m => m t -> m u -> m t
>>~ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.space

kk_uint :: P Int
kk_uint :: P Int
kk_uint = do
  String
digits <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Read a => String -> a
read String
digits)

kk_int :: P Int
kk_int :: P Int
kk_int = do
  Maybe Char
sign <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'-')
  Int
unsigned <- P Int
kk_uint
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
unsigned (forall a b. a -> b -> a
const (forall a. Num a => a -> a
negate Int
unsigned)) Maybe Char
sign)

-- * Note elements parsers

kk_note_name_p :: P Char
kk_note_name_p :: P Char
kk_note_name_p = forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"abcdefg"

kk_midi_note_p :: P Int
kk_midi_note_p :: P Int
kk_midi_note_p = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'p' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P Int
kk_uint

kk_rest_p :: P Char
kk_rest_p :: P Char
kk_rest_p = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'r'

kk_accidental_p :: P Char
kk_accidental_p :: P Char
kk_accidental_p = forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"+-"

kk_char_to_note_number :: Char -> Int
kk_char_to_note_number :: Char -> Int
kk_char_to_note_number Char
c = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"kk_char_to_note_number?") (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
c (forall a b. [a] -> [b] -> [(a, b)]
zip String
"cdefgab" [Int
0, Int
2, Int
4, Int
5, Int
7, Int
9, Int
11]))

kk_char_to_alteration :: Char -> Int
kk_char_to_alteration :: Char -> Int
kk_char_to_alteration Char
c = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"kk_char_to_alteration?") (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
c (forall a b. [a] -> [b] -> [(a, b)]
zip String
"+-" [Int
1, -Int
1]))

-- > map kk_note_number_to_name [0 .. 11]
kk_note_number_to_name :: Int -> String
kk_note_number_to_name :: Int -> String
kk_note_number_to_name Int
k = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"kk_note_number_to_name?") (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
k (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (String -> [String]
words String
"c c+ d e- e f f+ g a- a b- b")))

kk_named_note_number_p :: P Int
kk_named_note_number_p :: P Int
kk_named_note_number_p = do
  Char
nm <- P Char
kk_note_name_p
  Maybe Char
ac <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe P Char
kk_accidental_p
  forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Int
kk_char_to_note_number Char
nm forall a. Num a => a -> a -> a
+ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Char -> Int
kk_char_to_alteration Maybe Char
ac)

kk_note_number_p :: P Int
kk_note_number_p :: P Int
kk_note_number_p = P Int
kk_named_note_number_p forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> P Int
kk_midi_note_p

-- | The octave key can be elided, ordinarily directly after the note name, ie. c2.
kk_modifier_p :: P (Char, Int)
kk_modifier_p :: P (Char, Int)
kk_modifier_p = do
  Maybe Char
c <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"ovdct")
  Int
n <- P Int
kk_int
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a -> a
fromMaybe Char
'o' Maybe Char
c, Int
n)

kk_modifiers_p :: P [(Char, Int)]
kk_modifiers_p :: P [(Char, Int)]
kk_modifiers_p = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many P (Char, Int)
kk_modifier_p

-- * Contextual note

{- | A note where all fields are optional.
If the note number is absent it indicates a rest.
All other fields infer values from the phrase context.
-}
data Kk_Contextual_Note =
  Kk_Contextual_Note
  {Kk_Contextual_Note -> Maybe Int
kk_contextual_note_number :: Maybe Int
  ,Kk_Contextual_Note -> Maybe Int
kk_contextual_note_octave :: Maybe Int
  ,Kk_Contextual_Note -> Maybe Int
kk_contextual_note_volume :: Maybe Int
  ,Kk_Contextual_Note -> Maybe Int
kk_contextual_note_duration :: Maybe Int
  ,Kk_Contextual_Note -> Maybe Int
kk_contextual_note_channel :: Maybe Int
  ,Kk_Contextual_Note -> Maybe Int
kk_contextual_note_time :: Maybe Int}
  deriving (Kk_Contextual_Note -> Kk_Contextual_Note -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Kk_Contextual_Note -> Kk_Contextual_Note -> Bool
$c/= :: Kk_Contextual_Note -> Kk_Contextual_Note -> Bool
== :: Kk_Contextual_Note -> Kk_Contextual_Note -> Bool
$c== :: Kk_Contextual_Note -> Kk_Contextual_Note -> Bool
Eq, Eq Kk_Contextual_Note
Kk_Contextual_Note -> Kk_Contextual_Note -> Bool
Kk_Contextual_Note -> Kk_Contextual_Note -> Ordering
Kk_Contextual_Note -> Kk_Contextual_Note -> Kk_Contextual_Note
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 :: Kk_Contextual_Note -> Kk_Contextual_Note -> Kk_Contextual_Note
$cmin :: Kk_Contextual_Note -> Kk_Contextual_Note -> Kk_Contextual_Note
max :: Kk_Contextual_Note -> Kk_Contextual_Note -> Kk_Contextual_Note
$cmax :: Kk_Contextual_Note -> Kk_Contextual_Note -> Kk_Contextual_Note
>= :: Kk_Contextual_Note -> Kk_Contextual_Note -> Bool
$c>= :: Kk_Contextual_Note -> Kk_Contextual_Note -> Bool
> :: Kk_Contextual_Note -> Kk_Contextual_Note -> Bool
$c> :: Kk_Contextual_Note -> Kk_Contextual_Note -> Bool
<= :: Kk_Contextual_Note -> Kk_Contextual_Note -> Bool
$c<= :: Kk_Contextual_Note -> Kk_Contextual_Note -> Bool
< :: Kk_Contextual_Note -> Kk_Contextual_Note -> Bool
$c< :: Kk_Contextual_Note -> Kk_Contextual_Note -> Bool
compare :: Kk_Contextual_Note -> Kk_Contextual_Note -> Ordering
$ccompare :: Kk_Contextual_Note -> Kk_Contextual_Note -> Ordering
Ord, Int -> Kk_Contextual_Note -> ShowS
[Kk_Contextual_Note] -> ShowS
Kk_Contextual_Note -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Kk_Contextual_Note] -> ShowS
$cshowList :: [Kk_Contextual_Note] -> ShowS
show :: Kk_Contextual_Note -> String
$cshow :: Kk_Contextual_Note -> String
showsPrec :: Int -> Kk_Contextual_Note -> ShowS
$cshowsPrec :: Int -> Kk_Contextual_Note -> ShowS
Show)

kk_empty_contextual_note :: Kk_Contextual_Note
kk_empty_contextual_note :: Kk_Contextual_Note
kk_empty_contextual_note = Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Kk_Contextual_Note
Kk_Contextual_Note forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

kk_empty_contextual_rest :: Int -> Kk_Contextual_Note
kk_empty_contextual_rest :: Int -> Kk_Contextual_Note
kk_empty_contextual_rest Int
n = Kk_Contextual_Note
kk_empty_contextual_note {kk_contextual_note_duration :: Maybe Int
kk_contextual_note_duration = forall a. a -> Maybe a
Just Int
n}

{- | If t is set and is at the end time of the previous note print a preceding comma, else print t annotation.

> c = kk_empty_contextual_note {kk_contextual_note_number = Just 0, kk_contextual_time = Just 96}
> map (\t -> kk_contextual_note_pp (t, c)) [0, 96] == ["ct96",", c"]
-}
kk_contextual_note_pp :: (Int, Kk_Contextual_Note) -> String
kk_contextual_note_pp :: (Int, Kk_Contextual_Note) -> String
kk_contextual_note_pp (Int
t', Kk_Contextual_Note Maybe Int
n Maybe Int
o Maybe Int
v Maybe Int
d Maybe Int
c Maybe Int
t) =
  let f :: Char -> Maybe a -> String
f Char
i Maybe a
j = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((if Char
i forall a. Eq a => a -> a -> Bool
== Char
'o' then forall a. a -> a
id else (Char
i forall a. a -> [a] -> [a]
:)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe a
j
      (String
pre, String
t'') = if Maybe Int
t forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Int
t' then (String
", ",String
"") else (String
"", forall {a}. Show a => Char -> Maybe a -> String
f Char
't' Maybe Int
t)
  in case Maybe Int
n of
          Maybe Int
Nothing -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
pre, String
"r", forall {a}. Show a => Char -> Maybe a -> String
f Char
'd' Maybe Int
d, String
t'']
          Just Int
k -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
pre, Int -> String
kk_note_number_to_name Int
k, forall {a}. Show a => Char -> Maybe a -> String
f Char
'o' Maybe Int
o, forall {a}. Show a => Char -> Maybe a -> String
f Char
'v' Maybe Int
v, forall {a}. Show a => Char -> Maybe a -> String
f Char
'd' Maybe Int
d, forall {a}. Show a => Char -> Maybe a -> String
f Char
'c' Maybe Int
c, String
t'']

{- | If the note number is given as p60, then derive octave of and set it, ignoring any modifier.
Note that in KeyKit c3 is p60 or middle c.
-}
kk_contextual_note_p :: P Kk_Contextual_Note
kk_contextual_note_p :: P Kk_Contextual_Note
kk_contextual_note_p = do
  Maybe Int
n <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just P Int
kk_note_number_p forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> (P Char
kk_rest_p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
  [(Char, Int)]
m <- P [(Char, Int)]
kk_modifiers_p
  String
_ <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.space
  let get :: Char -> Maybe Int
get Char
c = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
c [(Char, Int)]
m
      (Maybe Int
n', Maybe Int
o) =
        case Maybe Int
n of
          Just Int
n'' ->
            if Int
n'' forall a. Ord a => a -> a -> Bool
> Int
11
            then
              let (Int
o', Int
n''') = Int
n'' forall a. Integral a => a -> a -> (a, a)
`divMod` Int
12
              in (forall a. a -> Maybe a
Just Int
n''', forall a. a -> Maybe a
Just (Int
o' forall a. Num a => a -> a -> a
- Int
2))
            else (Maybe Int
n, Char -> Maybe Int
get Char
'o')
          Maybe Int
Nothing -> (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
  forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Kk_Contextual_Note
Kk_Contextual_Note Maybe Int
n' Maybe Int
o (Char -> Maybe Int
get Char
'v') (Char -> Maybe Int
get Char
'd') (Char -> Maybe Int
get Char
'c') (Char -> Maybe Int
get Char
't'))

kk_contextual_note_is_rest :: Kk_Contextual_Note -> Bool
kk_contextual_note_is_rest :: Kk_Contextual_Note -> Bool
kk_contextual_note_is_rest = forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kk_Contextual_Note -> Maybe Int
kk_contextual_note_number

kk_comma_p :: P Char
kk_comma_p :: P Char
kk_comma_p = forall t. P t -> P t
kk_lexeme (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
',')

-- | A contextual note and an is_parallel? indicator.
kk_contextual_phrase_element_p :: P (Kk_Contextual_Note, Bool)
kk_contextual_phrase_element_p :: P (Kk_Contextual_Note, Bool)
kk_contextual_phrase_element_p = do
  Kk_Contextual_Note
n <- P Kk_Contextual_Note
kk_contextual_note_p
  Maybe Char
c <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe P Char
kk_comma_p
  forall (m :: * -> *) a. Monad m => a -> m a
return (Kk_Contextual_Note
n, forall a. Maybe a -> Bool
isNothing Maybe Char
c)

kk_contextual_phrase_p :: P [(Kk_Contextual_Note, Bool)]
kk_contextual_phrase_p :: P [(Kk_Contextual_Note, Bool)]
kk_contextual_phrase_p = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many P (Kk_Contextual_Note, Bool)
kk_contextual_phrase_element_p

-- * Note

-- | A note with all fields required.
data Kk_Note =
  Kk_Note
  {Kk_Note -> Int
kk_note_number :: Int
  ,Kk_Note -> Int
kk_note_octave :: Int
  ,Kk_Note -> Int
kk_note_volume :: Int
  ,Kk_Note -> Int
kk_note_duration :: Int
  ,Kk_Note -> Int
kk_note_channel :: Int
  ,Kk_Note -> Int
kk_note_time :: Int}
  deriving (Kk_Note -> Kk_Note -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Kk_Note -> Kk_Note -> Bool
$c/= :: Kk_Note -> Kk_Note -> Bool
== :: Kk_Note -> Kk_Note -> Bool
$c== :: Kk_Note -> Kk_Note -> Bool
Eq, Eq Kk_Note
Kk_Note -> Kk_Note -> Bool
Kk_Note -> Kk_Note -> Ordering
Kk_Note -> Kk_Note -> Kk_Note
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 :: Kk_Note -> Kk_Note -> Kk_Note
$cmin :: Kk_Note -> Kk_Note -> Kk_Note
max :: Kk_Note -> Kk_Note -> Kk_Note
$cmax :: Kk_Note -> Kk_Note -> Kk_Note
>= :: Kk_Note -> Kk_Note -> Bool
$c>= :: Kk_Note -> Kk_Note -> Bool
> :: Kk_Note -> Kk_Note -> Bool
$c> :: Kk_Note -> Kk_Note -> Bool
<= :: Kk_Note -> Kk_Note -> Bool
$c<= :: Kk_Note -> Kk_Note -> Bool
< :: Kk_Note -> Kk_Note -> Bool
$c< :: Kk_Note -> Kk_Note -> Bool
compare :: Kk_Note -> Kk_Note -> Ordering
$ccompare :: Kk_Note -> Kk_Note -> Ordering
Ord, Int -> Kk_Note -> ShowS
[Kk_Note] -> ShowS
Kk_Note -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Kk_Note] -> ShowS
$cshowList :: [Kk_Note] -> ShowS
show :: Kk_Note -> String
$cshow :: Kk_Note -> String
showsPrec :: Int -> Kk_Note -> ShowS
$cshowsPrec :: Int -> Kk_Note -> ShowS
Show)

kk_default_note :: Kk_Note
kk_default_note :: Kk_Note
kk_default_note = Int -> Int -> Int -> Int -> Int -> Int -> Kk_Note
Kk_Note Int
60 Int
3 Int
63 Int
96 Int
1 Int
0

kk_note_to_initial_contextual_note :: Kk_Note -> Kk_Contextual_Note
kk_note_to_initial_contextual_note :: Kk_Note -> Kk_Contextual_Note
kk_note_to_initial_contextual_note (Kk_Note Int
n Int
o Int
v Int
d Int
c Int
t) =
  let f :: a -> a -> Maybe a
f a
i a
j = if a
i forall a. Eq a => a -> a -> Bool
== a
j then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just a
i
  in Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Kk_Contextual_Note
Kk_Contextual_Note (forall a. a -> Maybe a
Just Int
n) (forall {a}. Eq a => a -> a -> Maybe a
f Int
o Int
3) (forall {a}. Eq a => a -> a -> Maybe a
f Int
v Int
63) (forall {a}. Eq a => a -> a -> Maybe a
f Int
d Int
96) (forall {a}. Eq a => a -> a -> Maybe a
f Int
c Int
1) (forall {a}. Eq a => a -> a -> Maybe a
f Int
t Int
0)

kk_note_to_contextual_note :: Kk_Note -> Kk_Note -> (Int, Kk_Contextual_Note)
kk_note_to_contextual_note :: Kk_Note -> Kk_Note -> (Int, Kk_Contextual_Note)
kk_note_to_contextual_note (Kk_Note Int
_ Int
o' Int
v' Int
d' Int
c' Int
t') (Kk_Note Int
n Int
o Int
v Int
d Int
c Int
t) =
  let f :: a -> a -> Maybe a
f a
i a
j = if a
i forall a. Eq a => a -> a -> Bool
== a
j then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just a
i
  in (Int
t' forall a. Num a => a -> a -> a
+ Int
d', Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Kk_Contextual_Note
Kk_Contextual_Note (forall a. a -> Maybe a
Just Int
n) (forall {a}. Eq a => a -> a -> Maybe a
f Int
o Int
o') (forall {a}. Eq a => a -> a -> Maybe a
f Int
v Int
v') (forall {a}. Eq a => a -> a -> Maybe a
f Int
d Int
d') (forall {a}. Eq a => a -> a -> Maybe a
f Int
c Int
c') (forall {a}. Eq a => a -> a -> Maybe a
f Int
t Int
t'))

-- | Elide octave modifier character.
kk_note_pp :: Kk_Note -> String
kk_note_pp :: Kk_Note -> String
kk_note_pp (Kk_Note Int
n Int
o Int
v Int
d Int
c Int
t) = forall r. PrintfType r => String -> r
printf String
"%s%dv%dd%dc%dt%d" (Int -> String
kk_note_number_to_name Int
n) Int
o Int
v Int
d Int
c Int
t

kk_decontextualise_note :: Kk_Note -> Bool -> Kk_Contextual_Note -> Either Kk_Note Int
kk_decontextualise_note :: Kk_Note -> Bool -> Kk_Contextual_Note -> Either Kk_Note Int
kk_decontextualise_note (Kk_Note Int
_ Int
o Int
v Int
d Int
c Int
t) Bool
is_par (Kk_Contextual_Note Maybe Int
k' Maybe Int
o' Maybe Int
v' Maybe Int
d' Maybe Int
c' Maybe Int
t') =
  let t'' :: Int
t'' = forall a. a -> Maybe a -> a
fromMaybe (if Bool
is_par then Int
t else Int
t forall a. Num a => a -> a -> a
+ Int
d) Maybe Int
t'
  in case Maybe Int
k' of
    Just Int
k'' -> forall a b. a -> Either a b
Left (Int -> Int -> Int -> Int -> Int -> Int -> Kk_Note
Kk_Note Int
k'' (forall a. a -> Maybe a -> a
fromMaybe Int
o Maybe Int
o') (forall a. a -> Maybe a -> a
fromMaybe Int
v Maybe Int
v') (forall a. a -> Maybe a -> a
fromMaybe Int
d Maybe Int
d') (forall a. a -> Maybe a -> a
fromMaybe Int
c Maybe Int
c') Int
t'')
    Maybe Int
Nothing -> forall a b. b -> Either a b
Right Int
t''

data Kk_Phrase = Kk_Phrase { Kk_Phrase -> [Kk_Note]
kk_phrase_notes :: [Kk_Note], Kk_Phrase -> Int
kk_phrase_length :: Int } deriving (Kk_Phrase -> Kk_Phrase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Kk_Phrase -> Kk_Phrase -> Bool
$c/= :: Kk_Phrase -> Kk_Phrase -> Bool
== :: Kk_Phrase -> Kk_Phrase -> Bool
$c== :: Kk_Phrase -> Kk_Phrase -> Bool
Eq, Int -> Kk_Phrase -> ShowS
[Kk_Phrase] -> ShowS
Kk_Phrase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Kk_Phrase] -> ShowS
$cshowList :: [Kk_Phrase] -> ShowS
show :: Kk_Phrase -> String
$cshow :: Kk_Phrase -> String
showsPrec :: Int -> Kk_Phrase -> ShowS
$cshowsPrec :: Int -> Kk_Phrase -> ShowS
Show)

-- | This should, but does not, append a trailing rest as required.
kk_phrase_pp :: Kk_Phrase -> String
kk_phrase_pp :: Kk_Phrase -> String
kk_phrase_pp (Kk_Phrase [Kk_Note]
n Int
_) = [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map Kk_Note -> String
kk_note_pp [Kk_Note]
n)

-- | Rests are elided, their duration is accounted for in the time of the following notetaken into account.
kk_decontextualise_phrase :: [(Kk_Contextual_Note, Bool)] -> Kk_Phrase
kk_decontextualise_phrase :: [(Kk_Contextual_Note, Bool)] -> Kk_Phrase
kk_decontextualise_phrase =
  let f :: [Kk_Note]
-> Kk_Note -> Bool -> [(Kk_Contextual_Note, Bool)] -> Kk_Phrase
f [Kk_Note]
r Kk_Note
c Bool
p [(Kk_Contextual_Note, Bool)]
l =
        case [(Kk_Contextual_Note, Bool)]
l of
          [] -> [Kk_Note] -> Int -> Kk_Phrase
Kk_Phrase (forall a. [a] -> [a]
reverse [Kk_Note]
r) (Kk_Note -> Int
kk_note_time Kk_Note
c forall a. Num a => a -> a -> a
+ Kk_Note -> Int
kk_note_duration Kk_Note
c)
          (Kk_Contextual_Note
n,Bool
p'):[(Kk_Contextual_Note, Bool)]
l' ->
            case Kk_Note -> Bool -> Kk_Contextual_Note -> Either Kk_Note Int
kk_decontextualise_note Kk_Note
c Bool
p Kk_Contextual_Note
n of
              Left Kk_Note
c' -> [Kk_Note]
-> Kk_Note -> Bool -> [(Kk_Contextual_Note, Bool)] -> Kk_Phrase
f (Kk_Note
c' forall a. a -> [a] -> [a]
: [Kk_Note]
r) Kk_Note
c' Bool
p' [(Kk_Contextual_Note, Bool)]
l'
              Right Int
t' -> [Kk_Note]
-> Kk_Note -> Bool -> [(Kk_Contextual_Note, Bool)] -> Kk_Phrase
f [Kk_Note]
r (Kk_Note
c {kk_note_time :: Int
kk_note_time = Int
t'}) Bool
p' [(Kk_Contextual_Note, Bool)]
l'
  in [Kk_Note]
-> Kk_Note -> Bool -> [(Kk_Contextual_Note, Bool)] -> Kk_Phrase
f [] Kk_Note
kk_default_note Bool
True

-- | In addition to contextual note give end time of previous note, to allow for sequence (comma) notation.
kk_recontextualise_phrase :: Kk_Phrase -> [(Int, Kk_Contextual_Note)]
kk_recontextualise_phrase :: Kk_Phrase -> [(Int, Kk_Contextual_Note)]
kk_recontextualise_phrase Kk_Phrase
p =
  let f :: Kk_Note -> [Kk_Note] -> [(Int, Kk_Contextual_Note)]
f Kk_Note
n0 [Kk_Note]
n =
        case [Kk_Note]
n of
          [] -> []
          Kk_Note
n1 : [Kk_Note]
n' -> Kk_Note -> Kk_Note -> (Int, Kk_Contextual_Note)
kk_note_to_contextual_note Kk_Note
n0 Kk_Note
n1 forall a. a -> [a] -> [a]
: Kk_Note -> [Kk_Note] -> [(Int, Kk_Contextual_Note)]
f Kk_Note
n1 [Kk_Note]
n'
  in case Kk_Phrase
p of
    Kk_Phrase [] Int
l -> [(Int
0, Int -> Kk_Contextual_Note
kk_empty_contextual_rest Int
l)]
    Kk_Phrase (Kk_Note
n1 : [Kk_Note]
n') Int
_ ->
      let c1 :: Kk_Contextual_Note
c1 = Kk_Note -> Kk_Contextual_Note
kk_note_to_initial_contextual_note Kk_Note
n1
      in (Int
0, Kk_Contextual_Note
c1) forall a. a -> [a] -> [a]
: Kk_Note -> [Kk_Note] -> [(Int, Kk_Contextual_Note)]
f Kk_Note
n1 [Kk_Note]
n'

{- | Read KeyKit phrase constant.

> let rw = (\p -> (kk_phrase_pp p, kk_phrase_length p)) . kk_phrase_read
> rw "c" == ("c3v63d96c1t0",96)
> rw "c, r" == ("c3v63d96c1t0",192)
> rw "c, r, c3, r, p60" == ("c3v63d96c1t0 c3v63d96c1t192 c3v63d96c1t384",480)
> rw "c, e, g" == ("c3v63d96c1t0 e3v63d96c1t96 g3v63d96c1t192",288)
> rw "c2" == rw "co2"
-}
kk_phrase_read :: String -> Kk_Phrase
kk_phrase_read :: String -> Kk_Phrase
kk_phrase_read = [(Kk_Contextual_Note, Bool)] -> Kk_Phrase
kk_decontextualise_phrase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. P t -> String -> t
kk_parse P [(Kk_Contextual_Note, Bool)]
kk_contextual_phrase_p

{- | Re-contextualise and print phrase.

> rw = kk_phrase_print . kk_phrase_read
> rw_id i = rw i == i
> rw_id "c"
> rw_id "c e g"
> rw_id "c , e , g"
> rw_id "c e g , c f a , c e g , c e- g"
> rw_id "c , e , g c4t384"
> rw "c, r, c3, r, p60" == "c ct192 ct384"
> rw "c , e , g c4t288" == "c , e , g , c4"
> rw "c r" == "c" -- ?
-}
kk_phrase_print :: Kk_Phrase -> String
kk_phrase_print :: Kk_Phrase -> String
kk_phrase_print = [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Int, Kk_Contextual_Note) -> String
kk_contextual_note_pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kk_Phrase -> [(Int, Kk_Contextual_Note)]
kk_recontextualise_phrase