{-# LANGUAGE CPP #-}
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(..)
, 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
data Meter = Meter {
Meter -> Config
meter_config :: !Config
, Meter -> [MSection]
meter_sections :: ![MSection]
} 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
data MSection = MSection {
MSection -> Int
section_measures :: !Measures
, MSection -> Duration
section_measure_duration :: !Duration
, 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) }
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)
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
(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
type Duration = TrackTime
time_to_duration :: TrackTime -> Duration
time_to_duration :: Duration -> Duration
time_to_duration = Duration -> Duration
forall a. a -> a
id
data Config = Config {
Config -> Set Rank
config_labeled_ranks :: !(Set Rank)
, Config -> LabelConfig
config_label :: !LabelConfig
, Config -> Int
config_start_measure :: !Measures
, Config -> Int
config_min_depth :: !Int
, 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
}
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]
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]
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
instance Pretty LabelConfig where pretty :: LabelConfig -> Text
pretty = LabelConfig -> Text
forall a. Show a => a -> Text
showt
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 :: 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)
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
regular_subdivision :: [Int] -> AbstractMeter
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)
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))
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
, ( 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))
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)