-- Copyright 2021 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE CPP #-}
{- | Types to describe meters.

    A meter ruler divides up a block analogous to a staff notation meter.  It's
    actually more general, since the meter just says how to divide up a single
    measure, and only at one level, while the ruler has arbitrary divisions.
    However, in practice, it's convenient to use a similar organization to
    staff notation's meter.  So by convention the ranks are for section,
    measure, half note, etc., and "Cmd.TimeStep" uses abbreviated mnemonics of
    these durations for the various ruler ranks it can snap to.

    However, rank 'r_2', which corresponds to TimeStep's @'h'@, doesn't
    necessarily correspond to a half note.  It actually corresponds to the
    division below the measure, which in 3+3/8 is a dotted quarter.  In the
    case of 2/4 it would be a quarter note, but to keep the mnemonic names from
    getting too far from their staff notation counterparts, the 2/4 meter
    should skip a rank so that 'r_1' and 'r_2' both correspond to the same
    amount of time.
-}
module Ui.Meter.Meter (
    Meter(..), MSection(..), Measures
    , meter
    , meter_end
    , empty_meter
    , modify_config
    , set_sections, modify_sections
    , sections_split, sections_drop, sections_take
    , section_starts
    , Duration, time_to_duration
    , Config(..)
    , default_config
    , Rank(..), all_ranks
    , rank_names, rank_name
    , LabelConfig(..)
    , Label
    -- * AbstractMeter
    , AbstractMeter(..)
    , subdivide, subdivides
    , repeat, repeats
    , regular_subdivision
    , meter_length
#ifdef TESTING
    , module Ui.Meter.Meter
#endif
) where
import           Prelude hiding (repeat)
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified GHC.Generics as Generics

import qualified Util.Num as Num
import qualified Util.Pretty as Pretty
import           Util.Pretty ((<+>))
import qualified Util.Seq as Seq

import           Global
import           Types


-- | Duration is of one AbstractMeter, so total duration will be count*dur.
data Meter = Meter {
    Meter -> Config
meter_config :: !Config
    , Meter -> [MSection]
meter_sections :: ![MSection] -- I frequently modify the end, Seq, Vector?
    } deriving (Meter -> Meter -> Bool
(Meter -> Meter -> Bool) -> (Meter -> Meter -> Bool) -> Eq Meter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Meter -> Meter -> Bool
$c/= :: Meter -> Meter -> Bool
== :: Meter -> Meter -> Bool
$c== :: Meter -> Meter -> Bool
Eq, Int -> Meter -> ShowS
[Meter] -> ShowS
Meter -> String
(Int -> Meter -> ShowS)
-> (Meter -> String) -> ([Meter] -> ShowS) -> Show Meter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Meter] -> ShowS
$cshowList :: [Meter] -> ShowS
show :: Meter -> String
$cshow :: Meter -> String
showsPrec :: Int -> Meter -> ShowS
$cshowsPrec :: Int -> Meter -> ShowS
Show)

instance Pretty Meter where
    format :: Meter -> Doc
format (Meter Config
config [MSection]
sections) = Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"Meter"
        [ (Text
"config", Config -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Config
config)
        , (Text
"sections", [MSection] -> Doc
forall a. Pretty a => a -> Doc
Pretty.format [MSection]
sections)
        ]

instance Semigroup Meter where
    Meter
meter1 <> :: Meter -> Meter -> Meter
<> Meter
meter2 = Config -> [MSection] -> Meter
meter (Meter -> Config
meter_config Meter
meter1)
        (Meter -> [MSection]
meter_sections Meter
meter1 [MSection] -> [MSection] -> [MSection]
forall a. Semigroup a => a -> a -> a
<> Meter -> [MSection]
meter_sections Meter
meter2)
instance Monoid Meter where
    mempty :: Meter
mempty = Meter
empty_meter
    mappend :: Meter -> Meter -> Meter
mappend = Meter -> Meter -> Meter
forall a. Semigroup a => a -> a -> a
(<>)

empty_meter :: Meter
empty_meter :: Meter
empty_meter = Config -> [MSection] -> Meter
Meter Config
default_config []

meter_end :: Meter -> TrackTime
meter_end :: Meter -> Duration
meter_end = [Duration] -> Duration
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum ([Duration] -> Duration)
-> (Meter -> [Duration]) -> Meter -> Duration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MSection -> Duration) -> [MSection] -> [Duration]
forall a b. (a -> b) -> [a] -> [b]
map MSection -> Duration
section_duration ([MSection] -> [Duration])
-> (Meter -> [MSection]) -> Meter -> [Duration]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meter -> [MSection]
meter_sections

meter :: Config -> [MSection] -> Meter
meter :: Config -> [MSection] -> Meter
meter Config
config [MSection]
sections =
    [MSection] -> Meter -> Meter
set_sections ((MSection -> Bool) -> [MSection] -> [MSection]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) (Int -> Bool) -> (MSection -> Int) -> MSection -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSection -> Int
section_measures) [MSection]
sections) (Meter -> Meter) -> Meter -> Meter
forall a b. (a -> b) -> a -> b
$
    (Config -> Config) -> Meter -> Meter
modify_config (Config -> Config -> Config
forall a b. a -> b -> a
const Config
config) Meter
empty_meter

-- Called MSection due to annoying name clash with Rank Section.
-- If I change that one, then the change to rank_names affects parsing.
data MSection = MSection {
    -- | The section contains this many measures.
    MSection -> Int
section_measures :: !Measures
    -- | Each measure has this duration.
    , MSection -> Duration
section_measure_duration :: !Duration
    -- | Describe a measure.
    , MSection -> AbstractMeter
section_measure :: !AbstractMeter
    } deriving (MSection -> MSection -> Bool
(MSection -> MSection -> Bool)
-> (MSection -> MSection -> Bool) -> Eq MSection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MSection -> MSection -> Bool
$c/= :: MSection -> MSection -> Bool
== :: MSection -> MSection -> Bool
$c== :: MSection -> MSection -> Bool
Eq, Int -> MSection -> ShowS
[MSection] -> ShowS
MSection -> String
(Int -> MSection -> ShowS)
-> (MSection -> String) -> ([MSection] -> ShowS) -> Show MSection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MSection] -> ShowS
$cshowList :: [MSection] -> ShowS
show :: MSection -> String
$cshow :: MSection -> String
showsPrec :: Int -> MSection -> ShowS
$cshowsPrec :: Int -> MSection -> ShowS
Show)

instance Pretty MSection where
    format :: MSection -> Doc
format (MSection Int
measures Duration
dur AbstractMeter
measure) =
        Doc
"MSection" Doc -> Doc -> Doc
<+> Int -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Int
measures Doc -> Doc -> Doc
<+> Duration -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Duration
dur
            Doc -> Doc -> Doc
<+> AbstractMeter -> Doc
forall a. Pretty a => a -> Doc
Pretty.format AbstractMeter
measure

type Measures = Int

section_duration :: MSection -> Duration
section_duration :: MSection -> Duration
section_duration (MSection Int
measures Duration
dur AbstractMeter
_) = Int -> Duration
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
measures Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
* Duration
dur

modify_config :: (Config -> Config) -> Meter -> Meter
modify_config :: (Config -> Config) -> Meter -> Meter
modify_config Config -> Config
modify Meter
meter =
    Meter
meter { meter_config :: Config
meter_config = Config -> Config
modify (Meter -> Config
meter_config Meter
meter) }

set_sections :: [MSection] -> Meter -> Meter
set_sections :: [MSection] -> Meter -> Meter
set_sections = ([MSection] -> [MSection]) -> Meter -> Meter
modify_sections (([MSection] -> [MSection]) -> Meter -> Meter)
-> ([MSection] -> [MSection] -> [MSection])
-> [MSection]
-> Meter
-> Meter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MSection] -> [MSection] -> [MSection]
forall a b. a -> b -> a
const

modify_sections :: ([MSection] -> [MSection]) -> Meter -> Meter
modify_sections :: ([MSection] -> [MSection]) -> Meter -> Meter
modify_sections [MSection] -> [MSection]
modify Meter
meter =
    Meter
meter { meter_sections :: [MSection]
meter_sections = [MSection] -> [MSection]
modify (Meter -> [MSection]
meter_sections Meter
meter) }

-- | Trimming the AbstractMeter from the start will change the labels, but
-- that's probably desired everywhere except a pickup.
sections_drop :: TrackTime -> [MSection] -> [MSection]
sections_drop :: Duration -> [MSection] -> [MSection]
sections_drop Duration
start = ([MSection], [MSection]) -> [MSection]
forall a b. (a, b) -> b
snd (([MSection], [MSection]) -> [MSection])
-> ([MSection] -> ([MSection], [MSection]))
-> [MSection]
-> [MSection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> [MSection] -> ([MSection], [MSection])
sections_split Duration
start

sections_take :: TrackTime -> [MSection] -> [MSection]
sections_take :: Duration -> [MSection] -> [MSection]
sections_take Duration
end = ([MSection], [MSection]) -> [MSection]
forall a b. (a, b) -> a
fst (([MSection], [MSection]) -> [MSection])
-> ([MSection] -> ([MSection], [MSection]))
-> [MSection]
-> [MSection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> [MSection] -> ([MSection], [MSection])
sections_split Duration
end

sections_split :: TrackTime -> [MSection] -> ([MSection], [MSection])
sections_split :: Duration -> [MSection] -> ([MSection], [MSection])
sections_split Duration
at = if Duration
at Duration -> Duration -> Bool
forall a. Ord a => a -> a -> Bool
<= Duration
0 then ([],) else Duration -> [MSection] -> ([MSection], [MSection])
go Duration
0
    where
    go :: Duration -> [MSection] -> ([MSection], [MSection])
go Duration
_ [] = ([], [])
    go Duration
t (MSection
s : [MSection]
ss)
        | Duration
at Duration -> Duration -> Bool
forall a. Ord a => a -> a -> Bool
>= Duration
t2 = ([MSection] -> [MSection])
-> ([MSection], [MSection]) -> ([MSection], [MSection])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MSection
s:) ([MSection], [MSection])
rest
        | Duration
at Duration -> Duration -> Bool
forall a. Ord a => a -> a -> Bool
<= Duration
t = ([MSection] -> [MSection])
-> ([MSection], [MSection]) -> ([MSection], [MSection])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (MSection
s:) ([MSection], [MSection])
rest
        | Bool
otherwise = ([MSection] -> [MSection])
-> ([MSection] -> [MSection])
-> ([MSection], [MSection])
-> ([MSection], [MSection])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ([MSection]
pre++) ([MSection]
post++) ([MSection], [MSection])
rest
        where
        rest :: ([MSection], [MSection])
rest = Duration -> [MSection] -> ([MSection], [MSection])
go Duration
t2 [MSection]
ss
        t2 :: Duration
t2 = Duration
t Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
+ MSection -> Duration
section_duration MSection
s
        ([MSection]
pre, [MSection]
post) = Duration -> MSection -> ([MSection], [MSection])
section_split (Duration
atDuration -> Duration -> Duration
forall a. Num a => a -> a -> a
-Duration
t) MSection
s

section_split :: TrackTime -> MSection -> ([MSection], [MSection])
section_split :: Duration -> MSection -> ([MSection], [MSection])
section_split Duration
at (MSection Int
count Duration
dur AbstractMeter
meter)
    | Int
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (Int -> [MSection]
make_section Int
measures, Int -> [MSection]
make_section (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
measures))
    | Bool
otherwise =
        ( Int -> [MSection]
make_section Int
measures [MSection] -> [MSection] -> [MSection]
forall a. [a] -> [a] -> [a]
++ [MSection]
-> (MSection -> [MSection]) -> Maybe MSection -> [MSection]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (MSection -> [MSection] -> [MSection]
forall a. a -> [a] -> [a]
:[]) Maybe MSection
pre_section
        , [MSection]
-> (MSection -> [MSection]) -> Maybe MSection -> [MSection]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (MSection -> [MSection] -> [MSection]
forall a. a -> [a] -> [a]
:[]) Maybe MSection
post_section [MSection] -> [MSection] -> [MSection]
forall a. [a] -> [a] -> [a]
++ Int -> [MSection]
make_section (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
measuresInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
        )
    where
    make_section :: Int -> [MSection]
make_section Int
m
        | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
        | Bool
otherwise = [Int -> Duration -> AbstractMeter -> MSection
MSection Int
m Duration
dur AbstractMeter
meter]
    (Maybe MSection
pre_section, Maybe MSection
post_section) =
        ( Int -> Duration -> AbstractMeter -> MSection
MSection Int
1 (Int -> Duration
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ts Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
* Duration
tlen) (AbstractMeter -> MSection)
-> Maybe AbstractMeter -> Maybe MSection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AbstractMeter
pre
        , Int -> Duration -> AbstractMeter -> MSection
MSection Int
1 (Duration
dur Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
- Int -> Duration
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ts Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
* Duration
tlen) (AbstractMeter -> MSection)
-> Maybe AbstractMeter -> Maybe MSection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AbstractMeter
post
        )
        where (Maybe AbstractMeter
pre, Maybe AbstractMeter
post) = Int -> AbstractMeter -> (Maybe AbstractMeter, Maybe AbstractMeter)
meter_split Int
ts AbstractMeter
meter
    (Int
measures_, Duration
frac) = Duration -> (Int, Duration)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Duration
at Duration -> Duration -> Duration
forall a. Fractional a => a -> a -> a
/ Duration
dur)
    -- Since Duration is not Rational, I can easily get off and floor or
    -- ceiling will be surprising half the time.
    ts_ :: Int
ts_ = Duration -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Duration -> Int) -> Duration -> Int
forall a b. (a -> b) -> a -> b
$ (Duration
frac Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
* Duration
dur) Duration -> Duration -> Duration
forall a. Fractional a => a -> a -> a
/ Duration
tlen
    -- Because I use round, 'ts' could overflow and be ==mlen.
    (Int
measures, Int
ts)
        | Int
ts_ Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mlen = (Int
measures_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
ts_ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mlen)
        | Bool
otherwise = (Int
measures_, Int
ts_)
    mlen :: Int
mlen = AbstractMeter -> Int
meter_length AbstractMeter
meter
    tlen :: Duration
tlen = Duration
dur Duration -> Duration -> Duration
forall a. Fractional a => a -> a -> a
/ Int -> Duration
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mlen

section_starts :: [MSection] -> [(Duration, MSection)]
section_starts :: [MSection] -> [(Duration, MSection)]
section_starts [MSection]
sections =
    [Duration] -> [MSection] -> [(Duration, MSection)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Duration -> Duration -> Duration)
-> Duration -> [Duration] -> [Duration]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
(+) Duration
0 ((MSection -> Duration) -> [MSection] -> [Duration]
forall a b. (a -> b) -> [a] -> [b]
map MSection -> Duration
section_duration [MSection]
sections)) [MSection]
sections

-- | Duration between ruler marks.  Since these are added together, there is
-- a risk of accumulating innaccuracy.  I could use rationals if I changed
-- 'Ruler.PosMark' to rational, but for the moment it's more convenient to
-- stay as TrackTime, and convert to rationals before adding, assuming that
-- TrackTime has enough resolution to figure out what the rational should be.
--
-- TODO If I get more inaccuracy problems I should probably just switch to
-- rational, but it's a bit of a pain because Ruler.Marklist and its callers
-- have to change.  Also, I'm not even sure if it's a good idea, because
-- TrackTime is still floating point, so there will still be rounding in there
-- somewhere, and this would just put it in more places.
type Duration = TrackTime

-- | TODO it's id for now, but maybe I'll want to make it Rational at some
-- point?
time_to_duration :: TrackTime -> Duration
time_to_duration :: Duration -> Duration
time_to_duration = Duration -> Duration
forall a. a -> a
id

data Config = Config {
    -- | Only write labels on these ranks.
    Config -> Set Rank
config_labeled_ranks :: !(Set Rank)
    -- | How to generate labels.
    , Config -> LabelConfig
config_label :: !LabelConfig
    -- | The ruler should start counting at this number.  This could be measure
    -- number, or gong count, or avartanam count, whatever is the highest visual
    -- 'Label'.
    , Config -> Int
config_start_measure :: !Measures
    -- | Labels have at least this many sections.  Otherwise, trailing sections
    -- are omitted.
    , Config -> Int
config_min_depth :: !Int
    -- | Strip leading prefixes to this depth, via 'strip_prefixes'.
    , Config -> Int
config_strip_depth :: !Int
    } deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show, (forall x. Config -> Rep Config x)
-> (forall x. Rep Config x -> Config) -> Generic Config
forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Config x -> Config
$cfrom :: forall x. Config -> Rep Config x
Generics.Generic)

instance Pretty Config where format :: Config -> Doc
format = Config -> Doc
forall a. (PrettyG (Rep a), Generic a) => a -> Doc
Pretty.formatG_

default_config :: Config
default_config :: Config
default_config = Config
    { config_labeled_ranks :: Set Rank
config_labeled_ranks = Set Rank
default_labeled_ranks
    , config_label :: LabelConfig
config_label = Int -> LabelConfig
BigNumber Int
1
    , config_start_measure :: Int
config_start_measure = Int
1
    , config_min_depth :: Int
config_min_depth = Int
1
    , config_strip_depth :: Int
config_strip_depth = Int
2
    }

-- | By convention, ranks divide up the ruler by dividing it by two for each
-- rank.  This is convenient because that's how staff notation works.  But then
-- the labels wind up being all 0s and 1s, which is not that useful.  The ranks
-- in this list don't receive their own label.
default_labeled_ranks :: Set Rank
default_labeled_ranks :: Set Rank
default_labeled_ranks = [Rank] -> Set Rank
forall a. Ord a => [a] -> Set a
Set.fromList [Rank
W, Rank
Q, Rank
S, Rank
T128]

-- * Rank

-- Also used by Derive.Typecheck
data Rank = Section | W | H | Q | E | S | T32 | T64 | T128 | T256
    deriving (Int -> Rank -> ShowS
[Rank] -> ShowS
Rank -> String
(Int -> Rank -> ShowS)
-> (Rank -> String) -> ([Rank] -> ShowS) -> Show Rank
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rank] -> ShowS
$cshowList :: [Rank] -> ShowS
show :: Rank -> String
$cshow :: Rank -> String
showsPrec :: Int -> Rank -> ShowS
$cshowsPrec :: Int -> Rank -> ShowS
Show, Rank -> Rank -> Bool
(Rank -> Rank -> Bool) -> (Rank -> Rank -> Bool) -> Eq Rank
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rank -> Rank -> Bool
$c/= :: Rank -> Rank -> Bool
== :: Rank -> Rank -> Bool
$c== :: Rank -> Rank -> Bool
Eq, Eq Rank
Eq Rank
-> (Rank -> Rank -> Ordering)
-> (Rank -> Rank -> Bool)
-> (Rank -> Rank -> Bool)
-> (Rank -> Rank -> Bool)
-> (Rank -> Rank -> Bool)
-> (Rank -> Rank -> Rank)
-> (Rank -> Rank -> Rank)
-> Ord Rank
Rank -> Rank -> Bool
Rank -> Rank -> Ordering
Rank -> Rank -> Rank
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 :: Rank -> Rank -> Rank
$cmin :: Rank -> Rank -> Rank
max :: Rank -> Rank -> Rank
$cmax :: Rank -> Rank -> Rank
>= :: Rank -> Rank -> Bool
$c>= :: Rank -> Rank -> Bool
> :: Rank -> Rank -> Bool
$c> :: Rank -> Rank -> Bool
<= :: Rank -> Rank -> Bool
$c<= :: Rank -> Rank -> Bool
< :: Rank -> Rank -> Bool
$c< :: Rank -> Rank -> Bool
compare :: Rank -> Rank -> Ordering
$ccompare :: Rank -> Rank -> Ordering
Ord, Rank
Rank -> Rank -> Bounded Rank
forall a. a -> a -> Bounded a
maxBound :: Rank
$cmaxBound :: Rank
minBound :: Rank
$cminBound :: Rank
Bounded, Int -> Rank
Rank -> Int
Rank -> [Rank]
Rank -> Rank
Rank -> Rank -> [Rank]
Rank -> Rank -> Rank -> [Rank]
(Rank -> Rank)
-> (Rank -> Rank)
-> (Int -> Rank)
-> (Rank -> Int)
-> (Rank -> [Rank])
-> (Rank -> Rank -> [Rank])
-> (Rank -> Rank -> [Rank])
-> (Rank -> Rank -> Rank -> [Rank])
-> Enum Rank
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 :: Rank -> Rank -> Rank -> [Rank]
$cenumFromThenTo :: Rank -> Rank -> Rank -> [Rank]
enumFromTo :: Rank -> Rank -> [Rank]
$cenumFromTo :: Rank -> Rank -> [Rank]
enumFromThen :: Rank -> Rank -> [Rank]
$cenumFromThen :: Rank -> Rank -> [Rank]
enumFrom :: Rank -> [Rank]
$cenumFrom :: Rank -> [Rank]
fromEnum :: Rank -> Int
$cfromEnum :: Rank -> Int
toEnum :: Int -> Rank
$ctoEnum :: Int -> Rank
pred :: Rank -> Rank
$cpred :: Rank -> Rank
succ :: Rank -> Rank
$csucc :: Rank -> Rank
Enum)
instance Pretty Rank where pretty :: Rank -> Text
pretty = Rank -> Text
forall a. Show a => a -> Text
showt

all_ranks :: [Rank]
all_ranks :: [Rank]
all_ranks = [Rank
forall a. Bounded a => a
minBound .. Rank
forall a. Bounded a => a
maxBound]

-- | These are mnemonics for staff notation durations, though they may not
-- correspond exactly, as documented in "Cmd.Meter".
rank_names :: [(Rank, Text)]
rank_names :: [(Rank, Text)]
rank_names = [Rank] -> [Text] -> [(Rank, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Rank
forall a. Bounded a => a
minBound ..] ((Rank -> Text) -> [Rank] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Rank -> Text
rank_name [Rank]
all_ranks)

rank_name :: Rank -> Text
rank_name :: Rank -> Text
rank_name = Text -> Text
Text.toLower (Text -> Text) -> (Rank -> Text) -> Rank -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rank -> Text
forall a. Show a => a -> Text
showt

data LabelConfig = BigNumber Int | Cycle [Label]
    deriving (LabelConfig -> LabelConfig -> Bool
(LabelConfig -> LabelConfig -> Bool)
-> (LabelConfig -> LabelConfig -> Bool) -> Eq LabelConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LabelConfig -> LabelConfig -> Bool
$c/= :: LabelConfig -> LabelConfig -> Bool
== :: LabelConfig -> LabelConfig -> Bool
$c== :: LabelConfig -> LabelConfig -> Bool
Eq, Int -> LabelConfig -> ShowS
[LabelConfig] -> ShowS
LabelConfig -> String
(Int -> LabelConfig -> ShowS)
-> (LabelConfig -> String)
-> ([LabelConfig] -> ShowS)
-> Show LabelConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LabelConfig] -> ShowS
$cshowList :: [LabelConfig] -> ShowS
show :: LabelConfig -> String
$cshow :: LabelConfig -> String
showsPrec :: Int -> LabelConfig -> ShowS
$cshowsPrec :: Int -> LabelConfig -> ShowS
Show)
type Label = Text -- TODO make it ByteString so I can pass to c++ efficiently?

instance Pretty LabelConfig where pretty :: LabelConfig -> Text
pretty = LabelConfig -> Text
forall a. Show a => a -> Text
showt

-- * AbstractMeter

{- | An AbstractMeter is a structured description of how a unit of time is
    broken up into hiererchical sections.  A 'T' represents a mark with the
    unit duration, and a 'D' is a group of Meters.  The rank of each mark is
    determined by its nesting depth.

    Previously a 'T' could take a duration, but I didn't wind up using that
    feature, so I removed it.  So meters have to be built of multiples of a
    unit duration multiplied by some stretch factor.

    An AbstractMeter can be created either by declaring it outright, or by
    declaring a simpler AbstractMeter and subdividing or repeating it.
-}
data AbstractMeter = T | D [AbstractMeter]
    deriving (AbstractMeter -> AbstractMeter -> Bool
(AbstractMeter -> AbstractMeter -> Bool)
-> (AbstractMeter -> AbstractMeter -> Bool) -> Eq AbstractMeter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbstractMeter -> AbstractMeter -> Bool
$c/= :: AbstractMeter -> AbstractMeter -> Bool
== :: AbstractMeter -> AbstractMeter -> Bool
$c== :: AbstractMeter -> AbstractMeter -> Bool
Eq, Int -> AbstractMeter -> ShowS
[AbstractMeter] -> ShowS
AbstractMeter -> String
(Int -> AbstractMeter -> ShowS)
-> (AbstractMeter -> String)
-> ([AbstractMeter] -> ShowS)
-> Show AbstractMeter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbstractMeter] -> ShowS
$cshowList :: [AbstractMeter] -> ShowS
show :: AbstractMeter -> String
$cshow :: AbstractMeter -> String
showsPrec :: Int -> AbstractMeter -> ShowS
$cshowsPrec :: Int -> AbstractMeter -> ShowS
Show)

instance Pretty AbstractMeter where pretty :: AbstractMeter -> Text
pretty = AbstractMeter -> Text
forall a. Show a => a -> Text
showt

-- | Subdivide each mark into the given number @D@s.  This has the effect of
-- putting one layer of subdivision under the current structure.
subdivide :: Int -> AbstractMeter -> AbstractMeter
subdivide :: Int -> AbstractMeter -> AbstractMeter
subdivide Int
n = AbstractMeter -> AbstractMeter -> AbstractMeter
replace_t ([AbstractMeter] -> AbstractMeter
D (Int -> AbstractMeter -> [AbstractMeter]
forall a. Int -> a -> [a]
replicate Int
n AbstractMeter
T))

subdivides :: [Int] -> AbstractMeter -> AbstractMeter
subdivides :: [Int] -> AbstractMeter -> AbstractMeter
subdivides [Int]
divs AbstractMeter
meter = (Int -> AbstractMeter -> AbstractMeter)
-> AbstractMeter -> [Int] -> AbstractMeter
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> AbstractMeter -> AbstractMeter
subdivide AbstractMeter
meter ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
divs)

-- | Create a layer that repeats the given meter a certain number of times.
repeat :: Int -> AbstractMeter -> AbstractMeter
repeat :: Int -> AbstractMeter -> AbstractMeter
repeat Int
n AbstractMeter
meter = [AbstractMeter] -> AbstractMeter
D ([AbstractMeter] -> AbstractMeter)
-> [AbstractMeter] -> AbstractMeter
forall a b. (a -> b) -> a -> b
$ Int -> AbstractMeter -> [AbstractMeter]
forall a. Int -> a -> [a]
replicate Int
n AbstractMeter
meter

repeats :: [Int] -> AbstractMeter -> AbstractMeter
repeats :: [Int] -> AbstractMeter -> AbstractMeter
repeats [Int]
ns AbstractMeter
meter = (Int -> AbstractMeter -> AbstractMeter)
-> AbstractMeter -> [Int] -> AbstractMeter
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> AbstractMeter -> AbstractMeter
repeat AbstractMeter
meter [Int]
ns

-- | Form a meter based on regular subdivision.  E.g. [4, 4] is 4 groups of 4,
-- [3, 3] is like 9\/8, and [4, 3] is 4 groups of 3 (12\/8).
regular_subdivision :: [Int] -> AbstractMeter
    -- It's most natural to think of the list as big divisions on the left to
    -- small divisions on the right, so reverse the list.
regular_subdivision :: [Int] -> AbstractMeter
regular_subdivision [Int]
ns = (Int -> AbstractMeter -> AbstractMeter)
-> AbstractMeter -> [Int] -> AbstractMeter
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> AbstractMeter -> AbstractMeter
subdivide AbstractMeter
T ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
ns)

-- ** AbstractMeter utils

-- | Map the given function over all @T@s in the given AbstractMeter.
replace_t :: AbstractMeter -> AbstractMeter -> AbstractMeter
replace_t :: AbstractMeter -> AbstractMeter -> AbstractMeter
replace_t AbstractMeter
val (D [AbstractMeter]
ts) = [AbstractMeter] -> AbstractMeter
D ((AbstractMeter -> AbstractMeter)
-> [AbstractMeter] -> [AbstractMeter]
forall a b. (a -> b) -> [a] -> [b]
map (AbstractMeter -> AbstractMeter -> AbstractMeter
replace_t AbstractMeter
val) [AbstractMeter]
ts)
replace_t AbstractMeter
val AbstractMeter
T = AbstractMeter
val

meter_length :: AbstractMeter -> Int
meter_length :: AbstractMeter -> Int
meter_length (D [AbstractMeter]
ms) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum ((AbstractMeter -> Int) -> [AbstractMeter] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map AbstractMeter -> Int
meter_length [AbstractMeter]
ms)
meter_length AbstractMeter
T = Int
1

meter_drop_end :: Int -> AbstractMeter -> Maybe AbstractMeter
meter_drop_end :: Int -> AbstractMeter -> Maybe AbstractMeter
meter_drop_end Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = AbstractMeter -> Maybe AbstractMeter
forall a. a -> Maybe a
Just
    | Bool
otherwise = (AbstractMeter -> AbstractMeter)
-> Maybe AbstractMeter -> Maybe AbstractMeter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AbstractMeter -> AbstractMeter
meter_reverse (Maybe AbstractMeter -> Maybe AbstractMeter)
-> (AbstractMeter -> Maybe AbstractMeter)
-> AbstractMeter
-> Maybe AbstractMeter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AbstractMeter -> Maybe AbstractMeter
meter_drop Int
n (AbstractMeter -> Maybe AbstractMeter)
-> (AbstractMeter -> AbstractMeter)
-> AbstractMeter
-> Maybe AbstractMeter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractMeter -> AbstractMeter
meter_reverse

meter_reverse :: AbstractMeter -> AbstractMeter
meter_reverse :: AbstractMeter -> AbstractMeter
meter_reverse = \case
    AbstractMeter
T -> AbstractMeter
T
    D [AbstractMeter]
ts -> [AbstractMeter] -> AbstractMeter
D ([AbstractMeter] -> [AbstractMeter]
forall a. [a] -> [a]
reverse ((AbstractMeter -> AbstractMeter)
-> [AbstractMeter] -> [AbstractMeter]
forall a b. (a -> b) -> [a] -> [b]
map AbstractMeter -> AbstractMeter
meter_reverse [AbstractMeter]
ts))

-- | Drop the number of Ts.  This has to be in Maybe because there's no empty
-- AbstractMeter.
meter_drop :: Int -> AbstractMeter -> Maybe AbstractMeter
meter_drop :: Int -> AbstractMeter -> Maybe AbstractMeter
meter_drop Int
n = (Maybe AbstractMeter, Maybe AbstractMeter) -> Maybe AbstractMeter
forall a b. (a, b) -> b
snd ((Maybe AbstractMeter, Maybe AbstractMeter) -> Maybe AbstractMeter)
-> (AbstractMeter -> (Maybe AbstractMeter, Maybe AbstractMeter))
-> AbstractMeter
-> Maybe AbstractMeter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AbstractMeter -> (Maybe AbstractMeter, Maybe AbstractMeter)
meter_split Int
n

meter_take :: Int -> AbstractMeter -> Maybe AbstractMeter
meter_take :: Int -> AbstractMeter -> Maybe AbstractMeter
meter_take Int
n = (Maybe AbstractMeter, Maybe AbstractMeter) -> Maybe AbstractMeter
forall a b. (a, b) -> a
fst ((Maybe AbstractMeter, Maybe AbstractMeter) -> Maybe AbstractMeter)
-> (AbstractMeter -> (Maybe AbstractMeter, Maybe AbstractMeter))
-> AbstractMeter
-> Maybe AbstractMeter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AbstractMeter -> (Maybe AbstractMeter, Maybe AbstractMeter)
meter_split Int
n

meter_split :: Int -> AbstractMeter
    -> (Maybe AbstractMeter, Maybe AbstractMeter)
meter_split :: Int -> AbstractMeter -> (Maybe AbstractMeter, Maybe AbstractMeter)
meter_split Int
n AbstractMeter
m
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (Maybe AbstractMeter
forall a. Maybe a
Nothing, AbstractMeter -> Maybe AbstractMeter
forall a. a -> Maybe a
Just AbstractMeter
m)
    | Bool
otherwise = case (Int, ([AbstractMeter], [AbstractMeter]))
-> ([AbstractMeter], [AbstractMeter])
forall a b. (a, b) -> b
snd (Int -> [AbstractMeter] -> (Int, ([AbstractMeter], [AbstractMeter]))
forall {a}.
(Ord a, Num a) =>
a -> [AbstractMeter] -> (a, ([AbstractMeter], [AbstractMeter]))
go Int
n [AbstractMeter
m]) of
        ([AbstractMeter]
pre, [AbstractMeter]
post) -> ([AbstractMeter] -> Maybe AbstractMeter
forall a. [a] -> Maybe a
Seq.head [AbstractMeter]
pre, [AbstractMeter] -> Maybe AbstractMeter
forall a. [a] -> Maybe a
Seq.head [AbstractMeter]
post)
    where
    go :: a -> [AbstractMeter] -> (a, ([AbstractMeter], [AbstractMeter]))
go a
n = \case
        [AbstractMeter]
ts | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 -> (a
0, ([], [AbstractMeter]
ts))
        [] -> (a
n, ([], []))
        D [AbstractMeter]
subs : [AbstractMeter]
ts
            | a
n2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 ->
                ( a
0
                -- I don't have a use for D [] so those get stripped out.
                -- TODO should it be D (NonEmpty AbstractMeter) then?
                , ( if [AbstractMeter] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AbstractMeter]
pre then [] else [[AbstractMeter] -> AbstractMeter
D [AbstractMeter]
pre]
                  , if [AbstractMeter] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AbstractMeter]
post then [AbstractMeter]
ts else [AbstractMeter] -> AbstractMeter
D [AbstractMeter]
post AbstractMeter -> [AbstractMeter] -> [AbstractMeter]
forall a. a -> [a] -> [a]
: [AbstractMeter]
ts
                  )
                )
            | Bool
otherwise -> (a
n3, ([AbstractMeter] -> AbstractMeter
D [AbstractMeter]
subs AbstractMeter -> [AbstractMeter] -> [AbstractMeter]
forall a. a -> [a] -> [a]
: [AbstractMeter]
pre2, [AbstractMeter]
post2))
            -- | otherwise -> second (first (D subs :)) (go n2 ts)
            where
            (a
n2, ([AbstractMeter]
pre, [AbstractMeter]
post)) = a -> [AbstractMeter] -> (a, ([AbstractMeter], [AbstractMeter]))
go a
n [AbstractMeter]
subs
            (a
n3, ([AbstractMeter]
pre2, [AbstractMeter]
post2)) = a -> [AbstractMeter] -> (a, ([AbstractMeter], [AbstractMeter]))
go a
n2 [AbstractMeter]
ts
        AbstractMeter
T : [AbstractMeter]
ts -> (([AbstractMeter], [AbstractMeter])
 -> ([AbstractMeter], [AbstractMeter]))
-> (a, ([AbstractMeter], [AbstractMeter]))
-> (a, ([AbstractMeter], [AbstractMeter]))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([AbstractMeter] -> [AbstractMeter])
-> ([AbstractMeter], [AbstractMeter])
-> ([AbstractMeter], [AbstractMeter])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (AbstractMeter
T:)) (a -> [AbstractMeter] -> (a, ([AbstractMeter], [AbstractMeter]))
go (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) [AbstractMeter]
ts)