-- 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.Lists as Lists
import qualified Util.Num as Num
import qualified Util.Pretty as Pretty
import           Util.Pretty ((<+>))

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
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
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", forall a. Pretty a => a -> Doc
Pretty.format Config
config)
        , (Text
"sections", 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 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 = 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 = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map MSection -> Duration
section_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 (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
>Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSection -> Int
section_measures) [MSection]
sections) forall a b. (a -> b) -> a -> b
$
    (Config -> Config) -> Meter -> Meter
modify_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
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
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
<+> forall a. Pretty a => a -> Doc
Pretty.format Int
measures Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
Pretty.format Duration
dur
            Doc -> Doc -> 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
_) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
measures 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. (a, b) -> b
snd 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 = forall a b. (a, b) -> a
fst 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 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 forall a. Ord a => a -> a -> Bool
>= Duration
t2 = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MSection
s:) ([MSection], [MSection])
rest
        | Duration
at forall a. Ord a => a -> a -> Bool
<= Duration
t = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (MSection
s:) ([MSection], [MSection])
rest
        | Bool
otherwise = 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 forall a. Num a => a -> a -> a
+ MSection -> Duration
section_duration MSection
s
        ([MSection]
pre, [MSection]
post) = Duration -> MSection -> ([MSection], [MSection])
section_split (Duration
atforall 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 forall a. Ord a => a -> a -> Bool
<= Int
0 = (Int -> [MSection]
make_section Int
measures, Int -> [MSection]
make_section (Int
count forall a. Num a => a -> a -> a
- Int
measures))
    | Bool
otherwise =
        ( Int -> [MSection]
make_section Int
measures forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. a -> [a] -> [a]
:[]) Maybe MSection
pre_section
        , forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. a -> [a] -> [a]
:[]) Maybe MSection
post_section forall a. [a] -> [a] -> [a]
++ Int -> [MSection]
make_section (Int
count forall a. Num a => a -> a -> a
- Int
measuresforall a. Num a => a -> a -> a
-Int
1)
        )
    where
    make_section :: Int -> [MSection]
make_section Int
m
        | Int
m 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ts forall a. Num a => a -> a -> a
* Duration
tlen) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AbstractMeter
pre
        , Int -> Duration -> AbstractMeter -> MSection
MSection Int
1 (Duration
dur forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ts forall a. Num a => a -> a -> a
* Duration
tlen) 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) = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Duration
at 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_ = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ (Duration
frac forall a. Num a => a -> a -> a
* Duration
dur) 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_ forall a. Ord a => a -> a -> Bool
>= Int
mlen = (Int
measures_ forall a. Num a => a -> a -> a
+ Int
1, Int
ts_ 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 forall a. Fractional a => a -> a -> a
/ 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 =
    forall a b. [a] -> [b] -> [(a, b)]
zip (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) Duration
0 (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 = 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
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
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. 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 = 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 = 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
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
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
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
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]
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 = forall a. Show a => a -> Text
showt

all_ranks :: [Rank]
all_ranks :: [Rank]
all_ranks = [forall a. Bounded a => a
minBound .. 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 = forall a b. [a] -> [b] -> [(a, b)]
zip [forall a. Bounded a => a
minBound ..] (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
showt

data LabelConfig = BigNumber Int | Cycle [Label]
    deriving (LabelConfig -> LabelConfig -> Bool
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
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 = 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
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
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 = 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 (forall a. Int -> a -> [a]
replicate Int
n AbstractMeter
T))

subdivides :: [Int] -> AbstractMeter -> AbstractMeter
subdivides :: [Int] -> AbstractMeter -> AbstractMeter
subdivides [Int]
divs AbstractMeter
meter = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> AbstractMeter -> AbstractMeter
subdivide AbstractMeter
meter (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 forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
n AbstractMeter
meter

repeats :: [Int] -> AbstractMeter -> AbstractMeter
repeats :: [Int] -> AbstractMeter -> AbstractMeter
repeats [Int]
ns AbstractMeter
meter = 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> AbstractMeter -> AbstractMeter
subdivide AbstractMeter
T (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 (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) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum (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 forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. a -> Maybe a
Just
    | Bool
otherwise = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AbstractMeter -> AbstractMeter
meter_reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AbstractMeter -> Maybe AbstractMeter
meter_drop Int
n 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 (forall a. [a] -> [a]
reverse (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 = forall a b. (a, b) -> b
snd 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 = forall a b. (a, b) -> a
fst 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 forall a. Ord a => a -> a -> Bool
<= Int
0 = (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just AbstractMeter
m)
    | Bool
otherwise = case forall a b. (a, b) -> b
snd (forall {a}.
(Ord a, Num a) =>
a -> [AbstractMeter] -> (a, ([AbstractMeter], [AbstractMeter]))
go Int
n [AbstractMeter
m]) of
        ([AbstractMeter]
pre, [AbstractMeter]
post) -> (forall a. [a] -> Maybe a
Lists.head [AbstractMeter]
pre, forall a. [a] -> Maybe a
Lists.head [AbstractMeter]
post)
    where
    go :: a -> [AbstractMeter] -> (a, ([AbstractMeter], [AbstractMeter]))
go a
n = \case
        [AbstractMeter]
ts | a
n forall a. Ord a => a -> a -> Bool
<= a
0 -> (a
0, ([], [AbstractMeter]
ts))
        [] -> (a
n, ([], []))
        D [AbstractMeter]
subs : [AbstractMeter]
ts
            | a
n2 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AbstractMeter]
pre then [] else [[AbstractMeter] -> AbstractMeter
D [AbstractMeter]
pre]
                  , if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AbstractMeter]
post then [AbstractMeter]
ts else [AbstractMeter] -> AbstractMeter
D [AbstractMeter]
post forall a. a -> [a] -> [a]
: [AbstractMeter]
ts
                  )
                )
            | Bool
otherwise -> (a
n3, ([AbstractMeter] -> AbstractMeter
D [AbstractMeter]
subs 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 -> forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (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
nforall a. Num a => a -> a -> a
-a
1) [AbstractMeter]
ts)