{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Fadno.Notation where

import GHC.Generics
import Data.String
import Data.Default
import Fadno.Note
import Control.Lens hiding (pre)
import Data.Typeable
import Data.Ratio
import Data.Sequence (Seq,fromList)
import Data.Foldable
import Data.List
import Data.Maybe


-- valid time sig denoms
data Quanta = Q2|Q4|Q8|Q16|Q32|Q64
               deriving (Quanta -> Quanta -> Bool
(Quanta -> Quanta -> Bool)
-> (Quanta -> Quanta -> Bool) -> Eq Quanta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Quanta -> Quanta -> Bool
== :: Quanta -> Quanta -> Bool
$c/= :: Quanta -> Quanta -> Bool
/= :: Quanta -> Quanta -> Bool
Eq,Int -> Quanta -> ShowS
[Quanta] -> ShowS
Quanta -> String
(Int -> Quanta -> ShowS)
-> (Quanta -> String) -> ([Quanta] -> ShowS) -> Show Quanta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Quanta -> ShowS
showsPrec :: Int -> Quanta -> ShowS
$cshow :: Quanta -> String
show :: Quanta -> String
$cshowList :: [Quanta] -> ShowS
showList :: [Quanta] -> ShowS
Show,Eq Quanta
Eq Quanta =>
(Quanta -> Quanta -> Ordering)
-> (Quanta -> Quanta -> Bool)
-> (Quanta -> Quanta -> Bool)
-> (Quanta -> Quanta -> Bool)
-> (Quanta -> Quanta -> Bool)
-> (Quanta -> Quanta -> Quanta)
-> (Quanta -> Quanta -> Quanta)
-> Ord Quanta
Quanta -> Quanta -> Bool
Quanta -> Quanta -> Ordering
Quanta -> Quanta -> Quanta
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
$ccompare :: Quanta -> Quanta -> Ordering
compare :: Quanta -> Quanta -> Ordering
$c< :: Quanta -> Quanta -> Bool
< :: Quanta -> Quanta -> Bool
$c<= :: Quanta -> Quanta -> Bool
<= :: Quanta -> Quanta -> Bool
$c> :: Quanta -> Quanta -> Bool
> :: Quanta -> Quanta -> Bool
$c>= :: Quanta -> Quanta -> Bool
>= :: Quanta -> Quanta -> Bool
$cmax :: Quanta -> Quanta -> Quanta
max :: Quanta -> Quanta -> Quanta
$cmin :: Quanta -> Quanta -> Quanta
min :: Quanta -> Quanta -> Quanta
Ord,Int -> Quanta
Quanta -> Int
Quanta -> [Quanta]
Quanta -> Quanta
Quanta -> Quanta -> [Quanta]
Quanta -> Quanta -> Quanta -> [Quanta]
(Quanta -> Quanta)
-> (Quanta -> Quanta)
-> (Int -> Quanta)
-> (Quanta -> Int)
-> (Quanta -> [Quanta])
-> (Quanta -> Quanta -> [Quanta])
-> (Quanta -> Quanta -> [Quanta])
-> (Quanta -> Quanta -> Quanta -> [Quanta])
-> Enum Quanta
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Quanta -> Quanta
succ :: Quanta -> Quanta
$cpred :: Quanta -> Quanta
pred :: Quanta -> Quanta
$ctoEnum :: Int -> Quanta
toEnum :: Int -> Quanta
$cfromEnum :: Quanta -> Int
fromEnum :: Quanta -> Int
$cenumFrom :: Quanta -> [Quanta]
enumFrom :: Quanta -> [Quanta]
$cenumFromThen :: Quanta -> Quanta -> [Quanta]
enumFromThen :: Quanta -> Quanta -> [Quanta]
$cenumFromTo :: Quanta -> Quanta -> [Quanta]
enumFromTo :: Quanta -> Quanta -> [Quanta]
$cenumFromThenTo :: Quanta -> Quanta -> Quanta -> [Quanta]
enumFromThenTo :: Quanta -> Quanta -> Quanta -> [Quanta]
Enum,Quanta
Quanta -> Quanta -> Bounded Quanta
forall a. a -> a -> Bounded a
$cminBound :: Quanta
minBound :: Quanta
$cmaxBound :: Quanta
maxBound :: Quanta
Bounded,Typeable)

qToInt :: Quanta -> Int
qToInt :: Quanta -> Int
qToInt = (Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^) (Int -> Int) -> (Quanta -> Int) -> Quanta -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (Quanta -> Int) -> Quanta -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quanta -> Int
forall a. Enum a => a -> Int
fromEnum
qFromInt :: Integral i => i -> Maybe Quanta
qFromInt :: forall i. Integral i => i -> Maybe Quanta
qFromInt = (Int -> Quanta) -> Maybe Int -> Maybe Quanta
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Quanta
forall a. Enum a => Int -> a
toEnum (Maybe Int -> Maybe Quanta)
-> (i -> Maybe Int) -> i -> Maybe Quanta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> [i] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [i
2,i
4,i
8,i
16,i
32,i
64])


data TimeSignature = TimeSignature { TimeSignature -> Int
_tsLength :: Int, TimeSignature -> Quanta
_tsUnit :: Quanta }
   deriving (TimeSignature -> TimeSignature -> Bool
(TimeSignature -> TimeSignature -> Bool)
-> (TimeSignature -> TimeSignature -> Bool) -> Eq TimeSignature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeSignature -> TimeSignature -> Bool
== :: TimeSignature -> TimeSignature -> Bool
$c/= :: TimeSignature -> TimeSignature -> Bool
/= :: TimeSignature -> TimeSignature -> Bool
Eq,Eq TimeSignature
Eq TimeSignature =>
(TimeSignature -> TimeSignature -> Ordering)
-> (TimeSignature -> TimeSignature -> Bool)
-> (TimeSignature -> TimeSignature -> Bool)
-> (TimeSignature -> TimeSignature -> Bool)
-> (TimeSignature -> TimeSignature -> Bool)
-> (TimeSignature -> TimeSignature -> TimeSignature)
-> (TimeSignature -> TimeSignature -> TimeSignature)
-> Ord TimeSignature
TimeSignature -> TimeSignature -> Bool
TimeSignature -> TimeSignature -> Ordering
TimeSignature -> TimeSignature -> TimeSignature
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
$ccompare :: TimeSignature -> TimeSignature -> Ordering
compare :: TimeSignature -> TimeSignature -> Ordering
$c< :: TimeSignature -> TimeSignature -> Bool
< :: TimeSignature -> TimeSignature -> Bool
$c<= :: TimeSignature -> TimeSignature -> Bool
<= :: TimeSignature -> TimeSignature -> Bool
$c> :: TimeSignature -> TimeSignature -> Bool
> :: TimeSignature -> TimeSignature -> Bool
$c>= :: TimeSignature -> TimeSignature -> Bool
>= :: TimeSignature -> TimeSignature -> Bool
$cmax :: TimeSignature -> TimeSignature -> TimeSignature
max :: TimeSignature -> TimeSignature -> TimeSignature
$cmin :: TimeSignature -> TimeSignature -> TimeSignature
min :: TimeSignature -> TimeSignature -> TimeSignature
Ord)
instance Show TimeSignature where
    show :: TimeSignature -> String
show (TimeSignature Int
l Quanta
u) = Int -> String
forall a. Show a => a -> String
show Int
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Quanta -> String
forall a. Show a => a -> String
show Quanta
u
makeLenses ''TimeSignature
class HasTimeSignature a where timeSignature :: Lens' a (Maybe TimeSignature)

(/:) :: Int -> Quanta -> TimeSignature
/: :: Int -> Quanta -> TimeSignature
(/:) = Int -> Quanta -> TimeSignature
TimeSignature

-- PPQ: valid midi divisions, named after equivalent Quantum
-- as in, "1 means ..."; PQ4 is "1 means quarter note"
data PPQ = PQ4|PQ8|PQ16|PQ32|PQ64|PQ128|PQ256
         deriving (PPQ -> PPQ -> Bool
(PPQ -> PPQ -> Bool) -> (PPQ -> PPQ -> Bool) -> Eq PPQ
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PPQ -> PPQ -> Bool
== :: PPQ -> PPQ -> Bool
$c/= :: PPQ -> PPQ -> Bool
/= :: PPQ -> PPQ -> Bool
Eq,Int -> PPQ -> ShowS
[PPQ] -> ShowS
PPQ -> String
(Int -> PPQ -> ShowS)
-> (PPQ -> String) -> ([PPQ] -> ShowS) -> Show PPQ
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PPQ -> ShowS
showsPrec :: Int -> PPQ -> ShowS
$cshow :: PPQ -> String
show :: PPQ -> String
$cshowList :: [PPQ] -> ShowS
showList :: [PPQ] -> ShowS
Show,Eq PPQ
Eq PPQ =>
(PPQ -> PPQ -> Ordering)
-> (PPQ -> PPQ -> Bool)
-> (PPQ -> PPQ -> Bool)
-> (PPQ -> PPQ -> Bool)
-> (PPQ -> PPQ -> Bool)
-> (PPQ -> PPQ -> PPQ)
-> (PPQ -> PPQ -> PPQ)
-> Ord PPQ
PPQ -> PPQ -> Bool
PPQ -> PPQ -> Ordering
PPQ -> PPQ -> PPQ
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
$ccompare :: PPQ -> PPQ -> Ordering
compare :: PPQ -> PPQ -> Ordering
$c< :: PPQ -> PPQ -> Bool
< :: PPQ -> PPQ -> Bool
$c<= :: PPQ -> PPQ -> Bool
<= :: PPQ -> PPQ -> Bool
$c> :: PPQ -> PPQ -> Bool
> :: PPQ -> PPQ -> Bool
$c>= :: PPQ -> PPQ -> Bool
>= :: PPQ -> PPQ -> Bool
$cmax :: PPQ -> PPQ -> PPQ
max :: PPQ -> PPQ -> PPQ
$cmin :: PPQ -> PPQ -> PPQ
min :: PPQ -> PPQ -> PPQ
Ord,Int -> PPQ
PPQ -> Int
PPQ -> [PPQ]
PPQ -> PPQ
PPQ -> PPQ -> [PPQ]
PPQ -> PPQ -> PPQ -> [PPQ]
(PPQ -> PPQ)
-> (PPQ -> PPQ)
-> (Int -> PPQ)
-> (PPQ -> Int)
-> (PPQ -> [PPQ])
-> (PPQ -> PPQ -> [PPQ])
-> (PPQ -> PPQ -> [PPQ])
-> (PPQ -> PPQ -> PPQ -> [PPQ])
-> Enum PPQ
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PPQ -> PPQ
succ :: PPQ -> PPQ
$cpred :: PPQ -> PPQ
pred :: PPQ -> PPQ
$ctoEnum :: Int -> PPQ
toEnum :: Int -> PPQ
$cfromEnum :: PPQ -> Int
fromEnum :: PPQ -> Int
$cenumFrom :: PPQ -> [PPQ]
enumFrom :: PPQ -> [PPQ]
$cenumFromThen :: PPQ -> PPQ -> [PPQ]
enumFromThen :: PPQ -> PPQ -> [PPQ]
$cenumFromTo :: PPQ -> PPQ -> [PPQ]
enumFromTo :: PPQ -> PPQ -> [PPQ]
$cenumFromThenTo :: PPQ -> PPQ -> PPQ -> [PPQ]
enumFromThenTo :: PPQ -> PPQ -> PPQ -> [PPQ]
Enum,PPQ
PPQ -> PPQ -> Bounded PPQ
forall a. a -> a -> Bounded a
$cminBound :: PPQ
minBound :: PPQ
$cmaxBound :: PPQ
maxBound :: PPQ
Bounded)


-- convert to midi division value
ppqDiv :: Integral a => PPQ -> a
ppqDiv :: forall a. Integral a => PPQ -> a
ppqDiv = (a
2a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^) (Int -> a) -> (PPQ -> Int) -> PPQ -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PPQ -> Int
forall a. Enum a => a -> Int
fromEnum


-- Compute duration of TS
tsToRatio :: TimeSignature -> Rational
tsToRatio :: TimeSignature -> Rational
tsToRatio (TimeSignature Int
n Quanta
d) = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Quanta -> Int
qToInt Quanta
d)

-- Derive TS from duration, with 1 denominator implying Q4
tsFromRatio :: Rational -> Maybe TimeSignature
tsFromRatio :: Rational -> Maybe TimeSignature
tsFromRatio Rational
r = Integer -> Maybe TimeSignature
toTs (if Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then Integer
4 else (if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then Integer
2 else Integer
1))
    where toTs :: Integer -> Maybe TimeSignature
toTs Integer
m = (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
m) Int -> Quanta -> TimeSignature
/:) (Quanta -> TimeSignature) -> Maybe Quanta -> Maybe TimeSignature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Maybe Quanta
forall i. Integral i => i -> Maybe Quanta
qFromInt (Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
m)
          d :: Integer
d = Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r
          n :: Integer
n = Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r


tsFromRatio' :: TimeSignature -> Rational -> Maybe TimeSignature
tsFromRatio' :: TimeSignature -> Rational -> Maybe TimeSignature
tsFromRatio' (TimeSignature Int
_ Quanta
src) = (TimeSignature -> TimeSignature)
-> Maybe TimeSignature -> Maybe TimeSignature
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TimeSignature -> TimeSignature
adjust (Maybe TimeSignature -> Maybe TimeSignature)
-> (Rational -> Maybe TimeSignature)
-> Rational
-> Maybe TimeSignature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Maybe TimeSignature
tsFromRatio where
    adjust :: TimeSignature -> TimeSignature
adjust t :: TimeSignature
t@(TimeSignature Int
n Quanta
d) | Quanta
src Quanta -> Quanta -> Bool
forall a. Ord a => a -> a -> Bool
<= Quanta
d = TimeSignature
t
                                 | Bool
otherwise = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
m) Int -> Quanta -> TimeSignature
/: Quanta
src
                                 where qd :: Int
qd = Quanta -> Int
qToInt Quanta
d
                                       qs :: Int
qs = Quanta -> Int
qToInt Quanta
src
                                       m :: Int
m = Int
qs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
qd


-- | Duration iso, from Integral to Rational, given PPQ
ratioPPQ :: forall a . Integral a => PPQ -> Iso' a Rational
ratioPPQ :: forall a. Integral a => PPQ -> Iso' a Rational
ratioPPQ PPQ
p = (a -> Rational) -> (Rational -> a) -> Iso a a Rational Rational
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso a -> Rational
forall {a} {p}. (Integral a, Integral p) => p -> Ratio a
toRat Rational -> a
forall {b}. Integral b => Rational -> b
toInt where
    ppq4 :: a
ppq4 = PPQ -> a
forall a. Integral a => PPQ -> a
ppqDiv PPQ
p a -> a -> a
forall a. Num a => a -> a -> a
* (a
4 :: a)
    toRat :: p -> Ratio a
toRat p
i = p -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
i a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ppq4
    toInt :: Rational -> b
toInt Rational
r = Rational -> b
forall {b}. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Rational
r Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* a -> Rational
forall a. Real a => a -> Rational
toRational a
ppq4)

-- | Adapt a type to its HasXXX "Maybe Lens'"
adaptHas :: Lens' a (Maybe a)
adaptHas :: forall a (f :: * -> *).
Functor f =>
(Maybe a -> f (Maybe a)) -> a -> f a
adaptHas Maybe a -> f (Maybe a)
f a
s = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
s (Maybe a -> a) -> f (Maybe a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a -> f (Maybe a)
f (a -> Maybe a
forall a. a -> Maybe a
Just a
s)

-- | Adapt a non-Maybe lens to the HasXXX "Maybe Lens'"
adaptHasLens :: Lens' s a -> Lens' s (Maybe a)
adaptHasLens :: forall s a. Lens' s a -> Lens' s (Maybe a)
adaptHasLens Lens' s a
l Maybe a -> f (Maybe a)
f s
s = (Maybe a -> s) -> f (Maybe a) -> f s
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s -> (a -> s) -> Maybe a -> s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe s
s (\a
a -> ASetter s s a a -> a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s s a a
Lens' s a
l a
a s
s)) (Maybe a -> f (Maybe a)
f (a -> Maybe a
forall a. a -> Maybe a
Just (Getting a s a -> s -> a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting a s a
Lens' s a
l s
s)))

-- | Adapt a type that does NOT support the HasXXX feature.
adaptHasNot :: Lens' s (Maybe a)
adaptHasNot :: forall s a (f :: * -> *).
Functor f =>
(Maybe a -> f (Maybe a)) -> s -> f s
adaptHasNot Maybe a -> f (Maybe a)
f s
s = (Maybe a -> s) -> f (Maybe a) -> f s
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s -> Maybe a -> s
forall a b. a -> b -> a
const s
s) (Maybe a -> f (Maybe a)
f Maybe a
forall a. Maybe a
Nothing)


-- | Tied notes.
data Tie = TStart | TStop | TBoth
    deriving (Tie -> Tie -> Bool
(Tie -> Tie -> Bool) -> (Tie -> Tie -> Bool) -> Eq Tie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tie -> Tie -> Bool
== :: Tie -> Tie -> Bool
$c/= :: Tie -> Tie -> Bool
/= :: Tie -> Tie -> Bool
Eq,Tie
Tie -> Tie -> Bounded Tie
forall a. a -> a -> Bounded a
$cminBound :: Tie
minBound :: Tie
$cmaxBound :: Tie
maxBound :: Tie
Bounded,Int -> Tie
Tie -> Int
Tie -> [Tie]
Tie -> Tie
Tie -> Tie -> [Tie]
Tie -> Tie -> Tie -> [Tie]
(Tie -> Tie)
-> (Tie -> Tie)
-> (Int -> Tie)
-> (Tie -> Int)
-> (Tie -> [Tie])
-> (Tie -> Tie -> [Tie])
-> (Tie -> Tie -> [Tie])
-> (Tie -> Tie -> Tie -> [Tie])
-> Enum Tie
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Tie -> Tie
succ :: Tie -> Tie
$cpred :: Tie -> Tie
pred :: Tie -> Tie
$ctoEnum :: Int -> Tie
toEnum :: Int -> Tie
$cfromEnum :: Tie -> Int
fromEnum :: Tie -> Int
$cenumFrom :: Tie -> [Tie]
enumFrom :: Tie -> [Tie]
$cenumFromThen :: Tie -> Tie -> [Tie]
enumFromThen :: Tie -> Tie -> [Tie]
$cenumFromTo :: Tie -> Tie -> [Tie]
enumFromTo :: Tie -> Tie -> [Tie]
$cenumFromThenTo :: Tie -> Tie -> Tie -> [Tie]
enumFromThenTo :: Tie -> Tie -> Tie -> [Tie]
Enum,Eq Tie
Eq Tie =>
(Tie -> Tie -> Ordering)
-> (Tie -> Tie -> Bool)
-> (Tie -> Tie -> Bool)
-> (Tie -> Tie -> Bool)
-> (Tie -> Tie -> Bool)
-> (Tie -> Tie -> Tie)
-> (Tie -> Tie -> Tie)
-> Ord Tie
Tie -> Tie -> Bool
Tie -> Tie -> Ordering
Tie -> Tie -> Tie
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
$ccompare :: Tie -> Tie -> Ordering
compare :: Tie -> Tie -> Ordering
$c< :: Tie -> Tie -> Bool
< :: Tie -> Tie -> Bool
$c<= :: Tie -> Tie -> Bool
<= :: Tie -> Tie -> Bool
$c> :: Tie -> Tie -> Bool
> :: Tie -> Tie -> Bool
$c>= :: Tie -> Tie -> Bool
>= :: Tie -> Tie -> Bool
$cmax :: Tie -> Tie -> Tie
max :: Tie -> Tie -> Tie
$cmin :: Tie -> Tie -> Tie
min :: Tie -> Tie -> Tie
Ord,Int -> Tie -> ShowS
[Tie] -> ShowS
Tie -> String
(Int -> Tie -> ShowS)
-> (Tie -> String) -> ([Tie] -> ShowS) -> Show Tie
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tie -> ShowS
showsPrec :: Int -> Tie -> ShowS
$cshow :: Tie -> String
show :: Tie -> String
$cshowList :: [Tie] -> ShowS
showList :: [Tie] -> ShowS
Show)
makeLenses ''Tie
class HasTie a where tie :: Lens' a (Maybe Tie)
instance HasTie Tie where tie :: Lens' Tie (Maybe Tie)
tie = (Maybe Tie -> f (Maybe Tie)) -> Tie -> f Tie
forall a (f :: * -> *).
Functor f =>
(Maybe a -> f (Maybe a)) -> a -> f a
adaptHas
instance HasTie (Note p d) where tie :: Lens' (Note p d) (Maybe Tie)
tie = (Maybe Tie -> f (Maybe Tie)) -> Note p d -> f (Note p d)
forall s a (f :: * -> *).
Functor f =>
(Maybe a -> f (Maybe a)) -> s -> f s
adaptHasNot


-- | Slurred notes.
data Slur = SStart | SStop
    deriving (Slur -> Slur -> Bool
(Slur -> Slur -> Bool) -> (Slur -> Slur -> Bool) -> Eq Slur
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Slur -> Slur -> Bool
== :: Slur -> Slur -> Bool
$c/= :: Slur -> Slur -> Bool
/= :: Slur -> Slur -> Bool
Eq,Slur
Slur -> Slur -> Bounded Slur
forall a. a -> a -> Bounded a
$cminBound :: Slur
minBound :: Slur
$cmaxBound :: Slur
maxBound :: Slur
Bounded,Int -> Slur
Slur -> Int
Slur -> [Slur]
Slur -> Slur
Slur -> Slur -> [Slur]
Slur -> Slur -> Slur -> [Slur]
(Slur -> Slur)
-> (Slur -> Slur)
-> (Int -> Slur)
-> (Slur -> Int)
-> (Slur -> [Slur])
-> (Slur -> Slur -> [Slur])
-> (Slur -> Slur -> [Slur])
-> (Slur -> Slur -> Slur -> [Slur])
-> Enum Slur
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Slur -> Slur
succ :: Slur -> Slur
$cpred :: Slur -> Slur
pred :: Slur -> Slur
$ctoEnum :: Int -> Slur
toEnum :: Int -> Slur
$cfromEnum :: Slur -> Int
fromEnum :: Slur -> Int
$cenumFrom :: Slur -> [Slur]
enumFrom :: Slur -> [Slur]
$cenumFromThen :: Slur -> Slur -> [Slur]
enumFromThen :: Slur -> Slur -> [Slur]
$cenumFromTo :: Slur -> Slur -> [Slur]
enumFromTo :: Slur -> Slur -> [Slur]
$cenumFromThenTo :: Slur -> Slur -> Slur -> [Slur]
enumFromThenTo :: Slur -> Slur -> Slur -> [Slur]
Enum,Eq Slur
Eq Slur =>
(Slur -> Slur -> Ordering)
-> (Slur -> Slur -> Bool)
-> (Slur -> Slur -> Bool)
-> (Slur -> Slur -> Bool)
-> (Slur -> Slur -> Bool)
-> (Slur -> Slur -> Slur)
-> (Slur -> Slur -> Slur)
-> Ord Slur
Slur -> Slur -> Bool
Slur -> Slur -> Ordering
Slur -> Slur -> Slur
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
$ccompare :: Slur -> Slur -> Ordering
compare :: Slur -> Slur -> Ordering
$c< :: Slur -> Slur -> Bool
< :: Slur -> Slur -> Bool
$c<= :: Slur -> Slur -> Bool
<= :: Slur -> Slur -> Bool
$c> :: Slur -> Slur -> Bool
> :: Slur -> Slur -> Bool
$c>= :: Slur -> Slur -> Bool
>= :: Slur -> Slur -> Bool
$cmax :: Slur -> Slur -> Slur
max :: Slur -> Slur -> Slur
$cmin :: Slur -> Slur -> Slur
min :: Slur -> Slur -> Slur
Ord,Int -> Slur -> ShowS
[Slur] -> ShowS
Slur -> String
(Int -> Slur -> ShowS)
-> (Slur -> String) -> ([Slur] -> ShowS) -> Show Slur
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Slur -> ShowS
showsPrec :: Int -> Slur -> ShowS
$cshow :: Slur -> String
show :: Slur -> String
$cshowList :: [Slur] -> ShowS
showList :: [Slur] -> ShowS
Show)
makeLenses ''Slur
class HasSlur a where slur :: Lens' a (Maybe Slur)
instance HasSlur Slur where slur :: Lens' Slur (Maybe Slur)
slur = (Maybe Slur -> f (Maybe Slur)) -> Slur -> f Slur
forall a (f :: * -> *).
Functor f =>
(Maybe a -> f (Maybe a)) -> a -> f a
adaptHas

-- | Note articulations.
data Articulation
    = Staccato
    | Accent
    -- | StrongAccent TODO implement after fixing fadno-xml #7
    | Tenuto
    | DetachedLegato
    | Staccatissimo
    | Spiccato
    | Scoop
    | Plop
    | Doit
    | Falloff
    | BreathMark
    | Caesura
    | Stress
    | Unstress
    | SoftAccent
    | OtherArticulation String
    deriving (Articulation -> Articulation -> Bool
(Articulation -> Articulation -> Bool)
-> (Articulation -> Articulation -> Bool) -> Eq Articulation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Articulation -> Articulation -> Bool
== :: Articulation -> Articulation -> Bool
$c/= :: Articulation -> Articulation -> Bool
/= :: Articulation -> Articulation -> Bool
Eq,Int -> Articulation -> ShowS
[Articulation] -> ShowS
Articulation -> String
(Int -> Articulation -> ShowS)
-> (Articulation -> String)
-> ([Articulation] -> ShowS)
-> Show Articulation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Articulation -> ShowS
showsPrec :: Int -> Articulation -> ShowS
$cshow :: Articulation -> String
show :: Articulation -> String
$cshowList :: [Articulation] -> ShowS
showList :: [Articulation] -> ShowS
Show,Eq Articulation
Eq Articulation =>
(Articulation -> Articulation -> Ordering)
-> (Articulation -> Articulation -> Bool)
-> (Articulation -> Articulation -> Bool)
-> (Articulation -> Articulation -> Bool)
-> (Articulation -> Articulation -> Bool)
-> (Articulation -> Articulation -> Articulation)
-> (Articulation -> Articulation -> Articulation)
-> Ord Articulation
Articulation -> Articulation -> Bool
Articulation -> Articulation -> Ordering
Articulation -> Articulation -> Articulation
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
$ccompare :: Articulation -> Articulation -> Ordering
compare :: Articulation -> Articulation -> Ordering
$c< :: Articulation -> Articulation -> Bool
< :: Articulation -> Articulation -> Bool
$c<= :: Articulation -> Articulation -> Bool
<= :: Articulation -> Articulation -> Bool
$c> :: Articulation -> Articulation -> Bool
> :: Articulation -> Articulation -> Bool
$c>= :: Articulation -> Articulation -> Bool
>= :: Articulation -> Articulation -> Bool
$cmax :: Articulation -> Articulation -> Articulation
max :: Articulation -> Articulation -> Articulation
$cmin :: Articulation -> Articulation -> Articulation
min :: Articulation -> Articulation -> Articulation
Ord)
class HasArticulation a where articulation :: Lens' a (Maybe Articulation)
instance HasArticulation Articulation where articulation :: Lens' Articulation (Maybe Articulation)
articulation = (Maybe Articulation -> f (Maybe Articulation))
-> Articulation -> f Articulation
forall a (f :: * -> *).
Functor f =>
(Maybe a -> f (Maybe a)) -> a -> f a
adaptHas


-- | Bar rehearsal mark.
newtype RehearsalMark = RehearsalMark { RehearsalMark -> String
_rehearsalText :: String }
    deriving (RehearsalMark -> RehearsalMark -> Bool
(RehearsalMark -> RehearsalMark -> Bool)
-> (RehearsalMark -> RehearsalMark -> Bool) -> Eq RehearsalMark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RehearsalMark -> RehearsalMark -> Bool
== :: RehearsalMark -> RehearsalMark -> Bool
$c/= :: RehearsalMark -> RehearsalMark -> Bool
/= :: RehearsalMark -> RehearsalMark -> Bool
Eq,Eq RehearsalMark
Eq RehearsalMark =>
(RehearsalMark -> RehearsalMark -> Ordering)
-> (RehearsalMark -> RehearsalMark -> Bool)
-> (RehearsalMark -> RehearsalMark -> Bool)
-> (RehearsalMark -> RehearsalMark -> Bool)
-> (RehearsalMark -> RehearsalMark -> Bool)
-> (RehearsalMark -> RehearsalMark -> RehearsalMark)
-> (RehearsalMark -> RehearsalMark -> RehearsalMark)
-> Ord RehearsalMark
RehearsalMark -> RehearsalMark -> Bool
RehearsalMark -> RehearsalMark -> Ordering
RehearsalMark -> RehearsalMark -> RehearsalMark
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
$ccompare :: RehearsalMark -> RehearsalMark -> Ordering
compare :: RehearsalMark -> RehearsalMark -> Ordering
$c< :: RehearsalMark -> RehearsalMark -> Bool
< :: RehearsalMark -> RehearsalMark -> Bool
$c<= :: RehearsalMark -> RehearsalMark -> Bool
<= :: RehearsalMark -> RehearsalMark -> Bool
$c> :: RehearsalMark -> RehearsalMark -> Bool
> :: RehearsalMark -> RehearsalMark -> Bool
$c>= :: RehearsalMark -> RehearsalMark -> Bool
>= :: RehearsalMark -> RehearsalMark -> Bool
$cmax :: RehearsalMark -> RehearsalMark -> RehearsalMark
max :: RehearsalMark -> RehearsalMark -> RehearsalMark
$cmin :: RehearsalMark -> RehearsalMark -> RehearsalMark
min :: RehearsalMark -> RehearsalMark -> RehearsalMark
Ord,String -> RehearsalMark
(String -> RehearsalMark) -> IsString RehearsalMark
forall a. (String -> a) -> IsString a
$cfromString :: String -> RehearsalMark
fromString :: String -> RehearsalMark
IsString,(forall x. RehearsalMark -> Rep RehearsalMark x)
-> (forall x. Rep RehearsalMark x -> RehearsalMark)
-> Generic RehearsalMark
forall x. Rep RehearsalMark x -> RehearsalMark
forall x. RehearsalMark -> Rep RehearsalMark x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RehearsalMark -> Rep RehearsalMark x
from :: forall x. RehearsalMark -> Rep RehearsalMark x
$cto :: forall x. Rep RehearsalMark x -> RehearsalMark
to :: forall x. Rep RehearsalMark x -> RehearsalMark
Generic,NonEmpty RehearsalMark -> RehearsalMark
RehearsalMark -> RehearsalMark -> RehearsalMark
(RehearsalMark -> RehearsalMark -> RehearsalMark)
-> (NonEmpty RehearsalMark -> RehearsalMark)
-> (forall b. Integral b => b -> RehearsalMark -> RehearsalMark)
-> Semigroup RehearsalMark
forall b. Integral b => b -> RehearsalMark -> RehearsalMark
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: RehearsalMark -> RehearsalMark -> RehearsalMark
<> :: RehearsalMark -> RehearsalMark -> RehearsalMark
$csconcat :: NonEmpty RehearsalMark -> RehearsalMark
sconcat :: NonEmpty RehearsalMark -> RehearsalMark
$cstimes :: forall b. Integral b => b -> RehearsalMark -> RehearsalMark
stimes :: forall b. Integral b => b -> RehearsalMark -> RehearsalMark
Semigroup,Semigroup RehearsalMark
RehearsalMark
Semigroup RehearsalMark =>
RehearsalMark
-> (RehearsalMark -> RehearsalMark -> RehearsalMark)
-> ([RehearsalMark] -> RehearsalMark)
-> Monoid RehearsalMark
[RehearsalMark] -> RehearsalMark
RehearsalMark -> RehearsalMark -> RehearsalMark
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: RehearsalMark
mempty :: RehearsalMark
$cmappend :: RehearsalMark -> RehearsalMark -> RehearsalMark
mappend :: RehearsalMark -> RehearsalMark -> RehearsalMark
$cmconcat :: [RehearsalMark] -> RehearsalMark
mconcat :: [RehearsalMark] -> RehearsalMark
Monoid,RehearsalMark
RehearsalMark -> Default RehearsalMark
forall a. a -> Default a
$cdef :: RehearsalMark
def :: RehearsalMark
Default)
makeLenses ''RehearsalMark
instance Show RehearsalMark where show :: RehearsalMark -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (RehearsalMark -> String) -> RehearsalMark -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RehearsalMark -> String
_rehearsalText
class HasRehearsalMark a where rehearsalMark :: Lens' a (Maybe RehearsalMark)
instance HasRehearsalMark RehearsalMark where rehearsalMark :: Lens' RehearsalMark (Maybe RehearsalMark)
rehearsalMark = (Maybe RehearsalMark -> f (Maybe RehearsalMark))
-> RehearsalMark -> f RehearsalMark
forall a (f :: * -> *).
Functor f =>
(Maybe a -> f (Maybe a)) -> a -> f a
adaptHas

-- | Musical direction.
newtype Direction = Direction { Direction -> String
_directionText :: String }
    deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq,Eq Direction
Eq Direction =>
(Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
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
$ccompare :: Direction -> Direction -> Ordering
compare :: Direction -> Direction -> Ordering
$c< :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
>= :: Direction -> Direction -> Bool
$cmax :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
min :: Direction -> Direction -> Direction
Ord,String -> Direction
(String -> Direction) -> IsString Direction
forall a. (String -> a) -> IsString a
$cfromString :: String -> Direction
fromString :: String -> Direction
IsString,(forall x. Direction -> Rep Direction x)
-> (forall x. Rep Direction x -> Direction) -> Generic Direction
forall x. Rep Direction x -> Direction
forall x. Direction -> Rep Direction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Direction -> Rep Direction x
from :: forall x. Direction -> Rep Direction x
$cto :: forall x. Rep Direction x -> Direction
to :: forall x. Rep Direction x -> Direction
Generic,NonEmpty Direction -> Direction
Direction -> Direction -> Direction
(Direction -> Direction -> Direction)
-> (NonEmpty Direction -> Direction)
-> (forall b. Integral b => b -> Direction -> Direction)
-> Semigroup Direction
forall b. Integral b => b -> Direction -> Direction
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Direction -> Direction -> Direction
<> :: Direction -> Direction -> Direction
$csconcat :: NonEmpty Direction -> Direction
sconcat :: NonEmpty Direction -> Direction
$cstimes :: forall b. Integral b => b -> Direction -> Direction
stimes :: forall b. Integral b => b -> Direction -> Direction
Semigroup,Semigroup Direction
Direction
Semigroup Direction =>
Direction
-> (Direction -> Direction -> Direction)
-> ([Direction] -> Direction)
-> Monoid Direction
[Direction] -> Direction
Direction -> Direction -> Direction
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Direction
mempty :: Direction
$cmappend :: Direction -> Direction -> Direction
mappend :: Direction -> Direction -> Direction
$cmconcat :: [Direction] -> Direction
mconcat :: [Direction] -> Direction
Monoid,Direction
Direction -> Default Direction
forall a. a -> Default a
$cdef :: Direction
def :: Direction
Default)
makeLenses ''Direction
instance Show Direction where show :: Direction -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (Direction -> String) -> Direction -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> String
_directionText
class HasDirection a where direction :: Lens' a (Maybe Direction)
instance HasDirection Direction where direction :: Lens' Direction (Maybe Direction)
direction = (Maybe Direction -> f (Maybe Direction))
-> Direction -> f Direction
forall a (f :: * -> *).
Functor f =>
(Maybe a -> f (Maybe a)) -> a -> f a
adaptHas

-- | Barline.
data Barline = Double | Final
    deriving (Barline -> Barline -> Bool
(Barline -> Barline -> Bool)
-> (Barline -> Barline -> Bool) -> Eq Barline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Barline -> Barline -> Bool
== :: Barline -> Barline -> Bool
$c/= :: Barline -> Barline -> Bool
/= :: Barline -> Barline -> Bool
Eq,Int -> Barline -> ShowS
[Barline] -> ShowS
Barline -> String
(Int -> Barline -> ShowS)
-> (Barline -> String) -> ([Barline] -> ShowS) -> Show Barline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Barline -> ShowS
showsPrec :: Int -> Barline -> ShowS
$cshow :: Barline -> String
show :: Barline -> String
$cshowList :: [Barline] -> ShowS
showList :: [Barline] -> ShowS
Show,Eq Barline
Eq Barline =>
(Barline -> Barline -> Ordering)
-> (Barline -> Barline -> Bool)
-> (Barline -> Barline -> Bool)
-> (Barline -> Barline -> Bool)
-> (Barline -> Barline -> Bool)
-> (Barline -> Barline -> Barline)
-> (Barline -> Barline -> Barline)
-> Ord Barline
Barline -> Barline -> Bool
Barline -> Barline -> Ordering
Barline -> Barline -> Barline
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
$ccompare :: Barline -> Barline -> Ordering
compare :: Barline -> Barline -> Ordering
$c< :: Barline -> Barline -> Bool
< :: Barline -> Barline -> Bool
$c<= :: Barline -> Barline -> Bool
<= :: Barline -> Barline -> Bool
$c> :: Barline -> Barline -> Bool
> :: Barline -> Barline -> Bool
$c>= :: Barline -> Barline -> Bool
>= :: Barline -> Barline -> Bool
$cmax :: Barline -> Barline -> Barline
max :: Barline -> Barline -> Barline
$cmin :: Barline -> Barline -> Barline
min :: Barline -> Barline -> Barline
Ord,(forall x. Barline -> Rep Barline x)
-> (forall x. Rep Barline x -> Barline) -> Generic Barline
forall x. Rep Barline x -> Barline
forall x. Barline -> Rep Barline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Barline -> Rep Barline x
from :: forall x. Barline -> Rep Barline x
$cto :: forall x. Rep Barline x -> Barline
to :: forall x. Rep Barline x -> Barline
Generic)
class HasBarline a where barline :: Lens' a (Maybe Barline)
instance HasBarline Barline where barline :: Lens' Barline (Maybe Barline)
barline = (Maybe Barline -> f (Maybe Barline)) -> Barline -> f Barline
forall a (f :: * -> *).
Functor f =>
(Maybe a -> f (Maybe a)) -> a -> f a
adaptHas

data Repeats = RStart | REnd | RBoth
    deriving (Repeats -> Repeats -> Bool
(Repeats -> Repeats -> Bool)
-> (Repeats -> Repeats -> Bool) -> Eq Repeats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Repeats -> Repeats -> Bool
== :: Repeats -> Repeats -> Bool
$c/= :: Repeats -> Repeats -> Bool
/= :: Repeats -> Repeats -> Bool
Eq,Int -> Repeats -> ShowS
[Repeats] -> ShowS
Repeats -> String
(Int -> Repeats -> ShowS)
-> (Repeats -> String) -> ([Repeats] -> ShowS) -> Show Repeats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Repeats -> ShowS
showsPrec :: Int -> Repeats -> ShowS
$cshow :: Repeats -> String
show :: Repeats -> String
$cshowList :: [Repeats] -> ShowS
showList :: [Repeats] -> ShowS
Show,Eq Repeats
Eq Repeats =>
(Repeats -> Repeats -> Ordering)
-> (Repeats -> Repeats -> Bool)
-> (Repeats -> Repeats -> Bool)
-> (Repeats -> Repeats -> Bool)
-> (Repeats -> Repeats -> Bool)
-> (Repeats -> Repeats -> Repeats)
-> (Repeats -> Repeats -> Repeats)
-> Ord Repeats
Repeats -> Repeats -> Bool
Repeats -> Repeats -> Ordering
Repeats -> Repeats -> Repeats
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
$ccompare :: Repeats -> Repeats -> Ordering
compare :: Repeats -> Repeats -> Ordering
$c< :: Repeats -> Repeats -> Bool
< :: Repeats -> Repeats -> Bool
$c<= :: Repeats -> Repeats -> Bool
<= :: Repeats -> Repeats -> Bool
$c> :: Repeats -> Repeats -> Bool
> :: Repeats -> Repeats -> Bool
$c>= :: Repeats -> Repeats -> Bool
>= :: Repeats -> Repeats -> Bool
$cmax :: Repeats -> Repeats -> Repeats
max :: Repeats -> Repeats -> Repeats
$cmin :: Repeats -> Repeats -> Repeats
min :: Repeats -> Repeats -> Repeats
Ord,(forall x. Repeats -> Rep Repeats x)
-> (forall x. Rep Repeats x -> Repeats) -> Generic Repeats
forall x. Rep Repeats x -> Repeats
forall x. Repeats -> Rep Repeats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Repeats -> Rep Repeats x
from :: forall x. Repeats -> Rep Repeats x
$cto :: forall x. Rep Repeats x -> Repeats
to :: forall x. Rep Repeats x -> Repeats
Generic)
class HasRepeats a where repeats :: Lens' a (Maybe Repeats)
instance HasRepeats Repeats where repeats :: Lens' Repeats (Maybe Repeats)
repeats = (Maybe Repeats -> f (Maybe Repeats)) -> Repeats -> f Repeats
forall a (f :: * -> *).
Functor f =>
(Maybe a -> f (Maybe a)) -> a -> f a
adaptHas

data Clef = TrebleClef | BassClef | AltoClef | PercClef
    deriving (Clef -> Clef -> Bool
(Clef -> Clef -> Bool) -> (Clef -> Clef -> Bool) -> Eq Clef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Clef -> Clef -> Bool
== :: Clef -> Clef -> Bool
$c/= :: Clef -> Clef -> Bool
/= :: Clef -> Clef -> Bool
Eq,Int -> Clef -> ShowS
[Clef] -> ShowS
Clef -> String
(Int -> Clef -> ShowS)
-> (Clef -> String) -> ([Clef] -> ShowS) -> Show Clef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Clef -> ShowS
showsPrec :: Int -> Clef -> ShowS
$cshow :: Clef -> String
show :: Clef -> String
$cshowList :: [Clef] -> ShowS
showList :: [Clef] -> ShowS
Show,Eq Clef
Eq Clef =>
(Clef -> Clef -> Ordering)
-> (Clef -> Clef -> Bool)
-> (Clef -> Clef -> Bool)
-> (Clef -> Clef -> Bool)
-> (Clef -> Clef -> Bool)
-> (Clef -> Clef -> Clef)
-> (Clef -> Clef -> Clef)
-> Ord Clef
Clef -> Clef -> Bool
Clef -> Clef -> Ordering
Clef -> Clef -> Clef
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
$ccompare :: Clef -> Clef -> Ordering
compare :: Clef -> Clef -> Ordering
$c< :: Clef -> Clef -> Bool
< :: Clef -> Clef -> Bool
$c<= :: Clef -> Clef -> Bool
<= :: Clef -> Clef -> Bool
$c> :: Clef -> Clef -> Bool
> :: Clef -> Clef -> Bool
$c>= :: Clef -> Clef -> Bool
>= :: Clef -> Clef -> Bool
$cmax :: Clef -> Clef -> Clef
max :: Clef -> Clef -> Clef
$cmin :: Clef -> Clef -> Clef
min :: Clef -> Clef -> Clef
Ord,(forall x. Clef -> Rep Clef x)
-> (forall x. Rep Clef x -> Clef) -> Generic Clef
forall x. Rep Clef x -> Clef
forall x. Clef -> Rep Clef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Clef -> Rep Clef x
from :: forall x. Clef -> Rep Clef x
$cto :: forall x. Rep Clef x -> Clef
to :: forall x. Rep Clef x -> Clef
Generic)
makeLenses ''Clef
class HasClef a where clef :: Lens' a (Maybe Clef)
instance HasClef Clef where clef :: Lens' Clef (Maybe Clef)
clef = (Maybe Clef -> f (Maybe Clef)) -> Clef -> f Clef
forall a (f :: * -> *).
Functor f =>
(Maybe a -> f (Maybe a)) -> a -> f a
adaptHas

-- | Adapts musicxml Beams where beams are labeled "1" for eighth beam etc,
-- where instead it is a list implying the first element is eighth etc.
data Beam
    = BeamBegin
    | BeamContinue
    | BeamEnd
    | BeamForwardHook
    | BeamBackwardHook
    deriving (Beam -> Beam -> Bool
(Beam -> Beam -> Bool) -> (Beam -> Beam -> Bool) -> Eq Beam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Beam -> Beam -> Bool
== :: Beam -> Beam -> Bool
$c/= :: Beam -> Beam -> Bool
/= :: Beam -> Beam -> Bool
Eq,Beam
Beam -> Beam -> Bounded Beam
forall a. a -> a -> Bounded a
$cminBound :: Beam
minBound :: Beam
$cmaxBound :: Beam
maxBound :: Beam
Bounded,Int -> Beam
Beam -> Int
Beam -> [Beam]
Beam -> Beam
Beam -> Beam -> [Beam]
Beam -> Beam -> Beam -> [Beam]
(Beam -> Beam)
-> (Beam -> Beam)
-> (Int -> Beam)
-> (Beam -> Int)
-> (Beam -> [Beam])
-> (Beam -> Beam -> [Beam])
-> (Beam -> Beam -> [Beam])
-> (Beam -> Beam -> Beam -> [Beam])
-> Enum Beam
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Beam -> Beam
succ :: Beam -> Beam
$cpred :: Beam -> Beam
pred :: Beam -> Beam
$ctoEnum :: Int -> Beam
toEnum :: Int -> Beam
$cfromEnum :: Beam -> Int
fromEnum :: Beam -> Int
$cenumFrom :: Beam -> [Beam]
enumFrom :: Beam -> [Beam]
$cenumFromThen :: Beam -> Beam -> [Beam]
enumFromThen :: Beam -> Beam -> [Beam]
$cenumFromTo :: Beam -> Beam -> [Beam]
enumFromTo :: Beam -> Beam -> [Beam]
$cenumFromThenTo :: Beam -> Beam -> Beam -> [Beam]
enumFromThenTo :: Beam -> Beam -> Beam -> [Beam]
Enum,Eq Beam
Eq Beam =>
(Beam -> Beam -> Ordering)
-> (Beam -> Beam -> Bool)
-> (Beam -> Beam -> Bool)
-> (Beam -> Beam -> Bool)
-> (Beam -> Beam -> Bool)
-> (Beam -> Beam -> Beam)
-> (Beam -> Beam -> Beam)
-> Ord Beam
Beam -> Beam -> Bool
Beam -> Beam -> Ordering
Beam -> Beam -> Beam
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
$ccompare :: Beam -> Beam -> Ordering
compare :: Beam -> Beam -> Ordering
$c< :: Beam -> Beam -> Bool
< :: Beam -> Beam -> Bool
$c<= :: Beam -> Beam -> Bool
<= :: Beam -> Beam -> Bool
$c> :: Beam -> Beam -> Bool
> :: Beam -> Beam -> Bool
$c>= :: Beam -> Beam -> Bool
>= :: Beam -> Beam -> Bool
$cmax :: Beam -> Beam -> Beam
max :: Beam -> Beam -> Beam
$cmin :: Beam -> Beam -> Beam
min :: Beam -> Beam -> Beam
Ord,Int -> Beam -> ShowS
[Beam] -> ShowS
Beam -> String
(Int -> Beam -> ShowS)
-> (Beam -> String) -> ([Beam] -> ShowS) -> Show Beam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Beam -> ShowS
showsPrec :: Int -> Beam -> ShowS
$cshow :: Beam -> String
show :: Beam -> String
$cshowList :: [Beam] -> ShowS
showList :: [Beam] -> ShowS
Show)
class HasBeams a where beams :: Lens' a [Beam]
instance HasBeams [Beam] where beams :: Lens' [Beam] [Beam]
beams = ([Beam] -> f [Beam]) -> [Beam] -> f [Beam]
forall a b. (a -> b) -> a -> b
($)

class HasVoice a where voice :: Lens' a (Maybe String)



-- | Part identifier, prefers 'Num' or 'IsString' values.
newtype Part a = Part { forall a. Part a -> a
_partIdx :: a }
    deriving (Part a -> Part a -> Bool
(Part a -> Part a -> Bool)
-> (Part a -> Part a -> Bool) -> Eq (Part a)
forall a. Eq a => Part a -> Part a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Part a -> Part a -> Bool
== :: Part a -> Part a -> Bool
$c/= :: forall a. Eq a => Part a -> Part a -> Bool
/= :: Part a -> Part a -> Bool
Eq,(forall x. Part a -> Rep (Part a) x)
-> (forall x. Rep (Part a) x -> Part a) -> Generic (Part a)
forall x. Rep (Part a) x -> Part a
forall x. Part a -> Rep (Part a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Part a) x -> Part a
forall a x. Part a -> Rep (Part a) x
$cfrom :: forall a x. Part a -> Rep (Part a) x
from :: forall x. Part a -> Rep (Part a) x
$cto :: forall a x. Rep (Part a) x -> Part a
to :: forall x. Rep (Part a) x -> Part a
Generic,Eq (Part a)
Eq (Part a) =>
(Part a -> Part a -> Ordering)
-> (Part a -> Part a -> Bool)
-> (Part a -> Part a -> Bool)
-> (Part a -> Part a -> Bool)
-> (Part a -> Part a -> Bool)
-> (Part a -> Part a -> Part a)
-> (Part a -> Part a -> Part a)
-> Ord (Part a)
Part a -> Part a -> Bool
Part a -> Part a -> Ordering
Part a -> Part a -> Part a
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
forall a. Ord a => Eq (Part a)
forall a. Ord a => Part a -> Part a -> Bool
forall a. Ord a => Part a -> Part a -> Ordering
forall a. Ord a => Part a -> Part a -> Part a
$ccompare :: forall a. Ord a => Part a -> Part a -> Ordering
compare :: Part a -> Part a -> Ordering
$c< :: forall a. Ord a => Part a -> Part a -> Bool
< :: Part a -> Part a -> Bool
$c<= :: forall a. Ord a => Part a -> Part a -> Bool
<= :: Part a -> Part a -> Bool
$c> :: forall a. Ord a => Part a -> Part a -> Bool
> :: Part a -> Part a -> Bool
$c>= :: forall a. Ord a => Part a -> Part a -> Bool
>= :: Part a -> Part a -> Bool
$cmax :: forall a. Ord a => Part a -> Part a -> Part a
max :: Part a -> Part a -> Part a
$cmin :: forall a. Ord a => Part a -> Part a -> Part a
min :: Part a -> Part a -> Part a
Ord,(forall a b. (a -> b) -> Part a -> Part b)
-> (forall a b. a -> Part b -> Part a) -> Functor Part
forall a b. a -> Part b -> Part a
forall a b. (a -> b) -> Part a -> Part b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Part a -> Part b
fmap :: forall a b. (a -> b) -> Part a -> Part b
$c<$ :: forall a b. a -> Part b -> Part a
<$ :: forall a b. a -> Part b -> Part a
Functor,Part a
Part a -> Part a -> Bounded (Part a)
forall a. a -> a -> Bounded a
forall a. Bounded a => Part a
$cminBound :: forall a. Bounded a => Part a
minBound :: Part a
$cmaxBound :: forall a. Bounded a => Part a
maxBound :: Part a
Bounded,(forall m. Monoid m => Part m -> m)
-> (forall m a. Monoid m => (a -> m) -> Part a -> m)
-> (forall m a. Monoid m => (a -> m) -> Part a -> m)
-> (forall a b. (a -> b -> b) -> b -> Part a -> b)
-> (forall a b. (a -> b -> b) -> b -> Part a -> b)
-> (forall b a. (b -> a -> b) -> b -> Part a -> b)
-> (forall b a. (b -> a -> b) -> b -> Part a -> b)
-> (forall a. (a -> a -> a) -> Part a -> a)
-> (forall a. (a -> a -> a) -> Part a -> a)
-> (forall a. Part a -> [a])
-> (forall a. Part a -> Bool)
-> (forall a. Part a -> Int)
-> (forall a. Eq a => a -> Part a -> Bool)
-> (forall a. Ord a => Part a -> a)
-> (forall a. Ord a => Part a -> a)
-> (forall a. Num a => Part a -> a)
-> (forall a. Num a => Part a -> a)
-> Foldable Part
forall a. Eq a => a -> Part a -> Bool
forall a. Num a => Part a -> a
forall a. Ord a => Part a -> a
forall m. Monoid m => Part m -> m
forall a. Part a -> Bool
forall a. Part a -> Int
forall a. Part a -> [a]
forall a. (a -> a -> a) -> Part a -> a
forall m a. Monoid m => (a -> m) -> Part a -> m
forall b a. (b -> a -> b) -> b -> Part a -> b
forall a b. (a -> b -> b) -> b -> Part a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Part m -> m
fold :: forall m. Monoid m => Part m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Part a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Part a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Part a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Part a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Part a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Part a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Part a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Part a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Part a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Part a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Part a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Part a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Part a -> a
foldr1 :: forall a. (a -> a -> a) -> Part a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Part a -> a
foldl1 :: forall a. (a -> a -> a) -> Part a -> a
$ctoList :: forall a. Part a -> [a]
toList :: forall a. Part a -> [a]
$cnull :: forall a. Part a -> Bool
null :: forall a. Part a -> Bool
$clength :: forall a. Part a -> Int
length :: forall a. Part a -> Int
$celem :: forall a. Eq a => a -> Part a -> Bool
elem :: forall a. Eq a => a -> Part a -> Bool
$cmaximum :: forall a. Ord a => Part a -> a
maximum :: forall a. Ord a => Part a -> a
$cminimum :: forall a. Ord a => Part a -> a
minimum :: forall a. Ord a => Part a -> a
$csum :: forall a. Num a => Part a -> a
sum :: forall a. Num a => Part a -> a
$cproduct :: forall a. Num a => Part a -> a
product :: forall a. Num a => Part a -> a
Foldable,Functor Part
Foldable Part
(Functor Part, Foldable Part) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Part a -> f (Part b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Part (f a) -> f (Part a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Part a -> m (Part b))
-> (forall (m :: * -> *) a. Monad m => Part (m a) -> m (Part a))
-> Traversable Part
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Part (m a) -> m (Part a)
forall (f :: * -> *) a. Applicative f => Part (f a) -> f (Part a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Part a -> m (Part b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Part a -> f (Part b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Part a -> f (Part b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Part a -> f (Part b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Part (f a) -> f (Part a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Part (f a) -> f (Part a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Part a -> m (Part b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Part a -> m (Part b)
$csequence :: forall (m :: * -> *) a. Monad m => Part (m a) -> m (Part a)
sequence :: forall (m :: * -> *) a. Monad m => Part (m a) -> m (Part a)
Traversable,Num (Part a)
Ord (Part a)
(Num (Part a), Ord (Part a)) =>
(Part a -> Rational) -> Real (Part a)
Part a -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
forall a. Real a => Num (Part a)
forall a. Real a => Ord (Part a)
forall a. Real a => Part a -> Rational
$ctoRational :: forall a. Real a => Part a -> Rational
toRational :: Part a -> Rational
Real,Integer -> Part a
Part a -> Part a
Part a -> Part a -> Part a
(Part a -> Part a -> Part a)
-> (Part a -> Part a -> Part a)
-> (Part a -> Part a -> Part a)
-> (Part a -> Part a)
-> (Part a -> Part a)
-> (Part a -> Part a)
-> (Integer -> Part a)
-> Num (Part a)
forall a. Num a => Integer -> Part a
forall a. Num a => Part a -> Part a
forall a. Num a => Part a -> Part a -> Part a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: forall a. Num a => Part a -> Part a -> Part a
+ :: Part a -> Part a -> Part a
$c- :: forall a. Num a => Part a -> Part a -> Part a
- :: Part a -> Part a -> Part a
$c* :: forall a. Num a => Part a -> Part a -> Part a
* :: Part a -> Part a -> Part a
$cnegate :: forall a. Num a => Part a -> Part a
negate :: Part a -> Part a
$cabs :: forall a. Num a => Part a -> Part a
abs :: Part a -> Part a
$csignum :: forall a. Num a => Part a -> Part a
signum :: Part a -> Part a
$cfromInteger :: forall a. Num a => Integer -> Part a
fromInteger :: Integer -> Part a
Num,String -> Part a
(String -> Part a) -> IsString (Part a)
forall a. IsString a => String -> Part a
forall a. (String -> a) -> IsString a
$cfromString :: forall a. IsString a => String -> Part a
fromString :: String -> Part a
IsString)
makeLenses ''Part
instance (Show a) => Show (Part a) where show :: Part a -> String
show = a -> String
forall a. Show a => a -> String
show(a -> String) -> (Part a -> a) -> Part a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Part a -> a
forall a. Part a -> a
_partIdx
class HasPart a b | a -> b where part :: Lens' a (Maybe (Part b))

-- | Lensy show of a Maybe field, given a 'Getter' and its name.
mshow :: (Show a) => Getter s (Maybe a) -> String -> s -> String
mshow :: forall a s. Show a => Getter s (Maybe a) -> String -> s -> String
mshow Getter s (Maybe a)
l String
n = String -> (a -> String) -> Maybe a -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\a
v -> String
" & " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ?~ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
v) (Maybe a -> String) -> (s -> Maybe a) -> s -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Maybe a) s (Maybe a) -> s -> Maybe a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe a) s (Maybe a)
Getter s (Maybe a)
l

-- | 'concatMap' show functions with a prelude.
mshows :: s -> String -> [s -> String] -> String
mshows :: forall s. s -> String -> [s -> String] -> String
mshows s
s String
pre = (String
pre String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ([s -> String] -> String) -> [s -> String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((s -> String) -> String) -> [s -> String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((s -> String) -> s -> String
forall a b. (a -> b) -> a -> b
$ s
s)

-- Example types.

-- | Note with notations.

type Note' p d = Noted (Note p d)

data Noted n = Noted {
      forall n. Noted n -> n
_nNote :: n
    , forall n. Noted n -> Maybe Tie
_nTie :: Maybe Tie
    , forall n. Noted n -> Maybe Slur
_nSlur :: Maybe Slur
    , forall n. Noted n -> Maybe Articulation
_nArticulation :: Maybe Articulation
    , forall n. Noted n -> [Beam]
_nBeams :: [Beam]
    , forall n. Noted n -> Maybe String
_nVoice :: Maybe String
    } deriving (Noted n -> Noted n -> Bool
(Noted n -> Noted n -> Bool)
-> (Noted n -> Noted n -> Bool) -> Eq (Noted n)
forall n. Eq n => Noted n -> Noted n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall n. Eq n => Noted n -> Noted n -> Bool
== :: Noted n -> Noted n -> Bool
$c/= :: forall n. Eq n => Noted n -> Noted n -> Bool
/= :: Noted n -> Noted n -> Bool
Eq,(forall x. Noted n -> Rep (Noted n) x)
-> (forall x. Rep (Noted n) x -> Noted n) -> Generic (Noted n)
forall x. Rep (Noted n) x -> Noted n
forall x. Noted n -> Rep (Noted n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n x. Rep (Noted n) x -> Noted n
forall n x. Noted n -> Rep (Noted n) x
$cfrom :: forall n x. Noted n -> Rep (Noted n) x
from :: forall x. Noted n -> Rep (Noted n) x
$cto :: forall n x. Rep (Noted n) x -> Noted n
to :: forall x. Rep (Noted n) x -> Noted n
Generic,(forall a b. (a -> b) -> Noted a -> Noted b)
-> (forall a b. a -> Noted b -> Noted a) -> Functor Noted
forall a b. a -> Noted b -> Noted a
forall a b. (a -> b) -> Noted a -> Noted b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Noted a -> Noted b
fmap :: forall a b. (a -> b) -> Noted a -> Noted b
$c<$ :: forall a b. a -> Noted b -> Noted a
<$ :: forall a b. a -> Noted b -> Noted a
Functor,(forall m. Monoid m => Noted m -> m)
-> (forall m a. Monoid m => (a -> m) -> Noted a -> m)
-> (forall m a. Monoid m => (a -> m) -> Noted a -> m)
-> (forall a b. (a -> b -> b) -> b -> Noted a -> b)
-> (forall a b. (a -> b -> b) -> b -> Noted a -> b)
-> (forall b a. (b -> a -> b) -> b -> Noted a -> b)
-> (forall b a. (b -> a -> b) -> b -> Noted a -> b)
-> (forall a. (a -> a -> a) -> Noted a -> a)
-> (forall a. (a -> a -> a) -> Noted a -> a)
-> (forall a. Noted a -> [a])
-> (forall a. Noted a -> Bool)
-> (forall a. Noted a -> Int)
-> (forall a. Eq a => a -> Noted a -> Bool)
-> (forall a. Ord a => Noted a -> a)
-> (forall a. Ord a => Noted a -> a)
-> (forall a. Num a => Noted a -> a)
-> (forall a. Num a => Noted a -> a)
-> Foldable Noted
forall a. Eq a => a -> Noted a -> Bool
forall a. Num a => Noted a -> a
forall a. Ord a => Noted a -> a
forall m. Monoid m => Noted m -> m
forall a. Noted a -> Bool
forall a. Noted a -> Int
forall a. Noted a -> [a]
forall a. (a -> a -> a) -> Noted a -> a
forall m a. Monoid m => (a -> m) -> Noted a -> m
forall b a. (b -> a -> b) -> b -> Noted a -> b
forall a b. (a -> b -> b) -> b -> Noted a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Noted m -> m
fold :: forall m. Monoid m => Noted m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Noted a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Noted a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Noted a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Noted a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Noted a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Noted a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Noted a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Noted a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Noted a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Noted a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Noted a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Noted a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Noted a -> a
foldr1 :: forall a. (a -> a -> a) -> Noted a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Noted a -> a
foldl1 :: forall a. (a -> a -> a) -> Noted a -> a
$ctoList :: forall a. Noted a -> [a]
toList :: forall a. Noted a -> [a]
$cnull :: forall a. Noted a -> Bool
null :: forall a. Noted a -> Bool
$clength :: forall a. Noted a -> Int
length :: forall a. Noted a -> Int
$celem :: forall a. Eq a => a -> Noted a -> Bool
elem :: forall a. Eq a => a -> Noted a -> Bool
$cmaximum :: forall a. Ord a => Noted a -> a
maximum :: forall a. Ord a => Noted a -> a
$cminimum :: forall a. Ord a => Noted a -> a
minimum :: forall a. Ord a => Noted a -> a
$csum :: forall a. Num a => Noted a -> a
sum :: forall a. Num a => Noted a -> a
$cproduct :: forall a. Num a => Noted a -> a
product :: forall a. Num a => Noted a -> a
Foldable,Functor Noted
Foldable Noted
(Functor Noted, Foldable Noted) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Noted a -> f (Noted b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Noted (f a) -> f (Noted a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Noted a -> m (Noted b))
-> (forall (m :: * -> *) a. Monad m => Noted (m a) -> m (Noted a))
-> Traversable Noted
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Noted (m a) -> m (Noted a)
forall (f :: * -> *) a. Applicative f => Noted (f a) -> f (Noted a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Noted a -> m (Noted b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Noted a -> f (Noted b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Noted a -> f (Noted b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Noted a -> f (Noted b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Noted (f a) -> f (Noted a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Noted (f a) -> f (Noted a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Noted a -> m (Noted b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Noted a -> m (Noted b)
$csequence :: forall (m :: * -> *) a. Monad m => Noted (m a) -> m (Noted a)
sequence :: forall (m :: * -> *) a. Monad m => Noted (m a) -> m (Noted a)
Traversable)

makeLenses ''Noted
instance HasNote (Note' p d) p d where
    note :: Lens' (Note' p d) (Note p d)
note = (Note p d -> f (Note p d)) -> Note' p d -> f (Note' p d)
forall n n (f :: * -> *).
Functor f =>
(n -> f n) -> Noted n -> f (Noted n)
nNote
    fromNote :: forall n. HasNote n p d => n -> Note' p d
fromNote = Note p d -> Note' p d
forall p d. Note p d -> Note' p d
note' (Note p d -> Note' p d) -> (n -> Note p d) -> n -> Note' p d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Note p d) n (Note p d) -> n -> Note p d
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Note p d) n (Note p d)
forall s p d. HasNote s p d => Lens' s (Note p d)
Lens' n (Note p d)
note
instance HasTie (Noted n) where tie :: Lens' (Noted n) (Maybe Tie)
tie = (Maybe Tie -> f (Maybe Tie)) -> Noted n -> f (Noted n)
forall n (f :: * -> *).
Functor f =>
(Maybe Tie -> f (Maybe Tie)) -> Noted n -> f (Noted n)
nTie
instance HasSlur (Noted n) where slur :: Lens' (Noted n) (Maybe Slur)
slur = (Maybe Slur -> f (Maybe Slur)) -> Noted n -> f (Noted n)
forall n (f :: * -> *).
Functor f =>
(Maybe Slur -> f (Maybe Slur)) -> Noted n -> f (Noted n)
nSlur
instance HasArticulation (Noted n) where articulation :: Lens' (Noted n) (Maybe Articulation)
articulation = (Maybe Articulation -> f (Maybe Articulation))
-> Noted n -> f (Noted n)
forall n (f :: * -> *).
Functor f =>
(Maybe Articulation -> f (Maybe Articulation))
-> Noted n -> f (Noted n)
nArticulation
instance HasBeams (Noted n) where beams :: Lens' (Noted n) [Beam]
beams = ([Beam] -> f [Beam]) -> Noted n -> f (Noted n)
forall n (f :: * -> *).
Functor f =>
([Beam] -> f [Beam]) -> Noted n -> f (Noted n)
nBeams
instance HasVoice (Noted n) where voice :: Lens' (Noted n) (Maybe String)
voice = (Maybe String -> f (Maybe String)) -> Noted n -> f (Noted n)
forall n (f :: * -> *).
Functor f =>
(Maybe String -> f (Maybe String)) -> Noted n -> f (Noted n)
nVoice
instance (Show n) => Show (Noted n) where
    show :: Noted n -> String
show Noted n
n = Noted n -> String -> [Noted n -> String] -> String
forall s. s -> String -> [s -> String] -> String
mshows Noted n
n (n -> String
forall a. Show a => a -> String
show (Getting n (Noted n) n -> Noted n -> n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting n (Noted n) n
forall n n (f :: * -> *).
Functor f =>
(n -> f n) -> Noted n -> f (Noted n)
nNote Noted n
n))
             [Getter (Noted n) (Maybe Tie) -> String -> Noted n -> String
forall a s. Show a => Getter s (Maybe a) -> String -> s -> String
mshow (Maybe Tie -> f (Maybe Tie)) -> Noted n -> f (Noted n)
forall a. HasTie a => Lens' a (Maybe Tie)
Lens' (Noted n) (Maybe Tie)
Getter (Noted n) (Maybe Tie)
tie String
"tie"
             ,Getter (Noted n) (Maybe Slur) -> String -> Noted n -> String
forall a s. Show a => Getter s (Maybe a) -> String -> s -> String
mshow (Maybe Slur -> f (Maybe Slur)) -> Noted n -> f (Noted n)
forall a. HasSlur a => Lens' a (Maybe Slur)
Lens' (Noted n) (Maybe Slur)
Getter (Noted n) (Maybe Slur)
slur String
"slur"
             ,Getter (Noted n) (Maybe Articulation)
-> String -> Noted n -> String
forall a s. Show a => Getter s (Maybe a) -> String -> s -> String
mshow (Maybe Articulation -> f (Maybe Articulation))
-> Noted n -> f (Noted n)
forall a. HasArticulation a => Lens' a (Maybe Articulation)
Lens' (Noted n) (Maybe Articulation)
Getter (Noted n) (Maybe Articulation)
articulation String
"articulation"
             ,String -> Noted n -> String
forall a b. a -> b -> a
const (String -> Noted n -> String) -> String -> Noted n -> String
forall a b. (a -> b) -> a -> b
$ case Getting [Beam] (Noted n) [Beam] -> Noted n -> [Beam]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Beam] (Noted n) [Beam]
forall a. HasBeams a => Lens' a [Beam]
Lens' (Noted n) [Beam]
beams Noted n
n of
                 [] -> String
""
                 [Beam]
bs -> String
" & beams .= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Beam] -> String
forall a. Show a => a -> String
show [Beam]
bs
             ,Getter (Noted n) (Maybe String) -> String -> Noted n -> String
forall a s. Show a => Getter s (Maybe a) -> String -> s -> String
mshow (Maybe String -> f (Maybe String)) -> Noted n -> f (Noted n)
forall a. HasVoice a => Lens' a (Maybe String)
Lens' (Noted n) (Maybe String)
Getter (Noted n) (Maybe String)
voice String
"voice"
             ]


-- | Note smart ctor, used in 'Show'.
note' :: Note p d -> Note' p d
note' :: forall p d. Note p d -> Note' p d
note' = Note p d -> Noted (Note p d)
forall n. n -> Noted n
noted

noted :: n -> Noted n
noted :: forall n. n -> Noted n
noted n
n = n
-> Maybe Tie
-> Maybe Slur
-> Maybe Articulation
-> [Beam]
-> Maybe String
-> Noted n
forall n.
n
-> Maybe Tie
-> Maybe Slur
-> Maybe Articulation
-> [Beam]
-> Maybe String
-> Noted n
Noted n
n Maybe Tie
forall a. Maybe a
Nothing Maybe Slur
forall a. Maybe a
Nothing Maybe Articulation
forall a. Maybe a
Nothing [] Maybe String
forall a. Maybe a
Nothing

testNote :: Note' [Int] Int
testNote :: Note' [Int] Int
testNote = Note [Int] Int -> Note' [Int] Int
forall p d. Note p d -> Note' p d
note' ([Int
60][Int] -> Int -> Note [Int] Int
forall p d. p -> d -> Note p d
|:Int
2) Note' [Int] Int
-> (Note' [Int] Int -> Note' [Int] Int) -> Note' [Int] Int
forall a b. a -> (a -> b) -> b
& (Maybe Tie -> Identity (Maybe Tie))
-> Note' [Int] Int -> Identity (Note' [Int] Int)
forall a. HasTie a => Lens' a (Maybe Tie)
Lens' (Note' [Int] Int) (Maybe Tie)
tie ((Maybe Tie -> Identity (Maybe Tie))
 -> Note' [Int] Int -> Identity (Note' [Int] Int))
-> Tie -> Note' [Int] Int -> Note' [Int] Int
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Tie
TStart Note' [Int] Int
-> (Note' [Int] Int -> Note' [Int] Int) -> Note' [Int] Int
forall a b. a -> (a -> b) -> b
& (Maybe Articulation -> Identity (Maybe Articulation))
-> Note' [Int] Int -> Identity (Note' [Int] Int)
forall a. HasArticulation a => Lens' a (Maybe Articulation)
Lens' (Note' [Int] Int) (Maybe Articulation)
articulation ((Maybe Articulation -> Identity (Maybe Articulation))
 -> Note' [Int] Int -> Identity (Note' [Int] Int))
-> Articulation -> Note' [Int] Int -> Note' [Int] Int
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Articulation
Accent

-- | Bar as list of notes, with notations.
data Bar n = Bar {
      forall n. Bar n -> Seq n
_bNotes :: Seq n
    , forall n. Bar n -> Maybe RehearsalMark
_bRehearsalMark :: Maybe RehearsalMark
    , forall n. Bar n -> Maybe Direction
_bDirection :: Maybe Direction
    , forall n. Bar n -> Maybe Barline
_bBarline :: Maybe Barline
    , forall n. Bar n -> Maybe Repeats
_bRepeats :: Maybe Repeats
    , forall n. Bar n -> Maybe TimeSignature
_bTimeSignature :: Maybe TimeSignature
    , forall n. Bar n -> Maybe Clef
_bClef :: Maybe Clef
    } deriving (Bar n -> Bar n -> Bool
(Bar n -> Bar n -> Bool) -> (Bar n -> Bar n -> Bool) -> Eq (Bar n)
forall n. Eq n => Bar n -> Bar n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall n. Eq n => Bar n -> Bar n -> Bool
== :: Bar n -> Bar n -> Bool
$c/= :: forall n. Eq n => Bar n -> Bar n -> Bool
/= :: Bar n -> Bar n -> Bool
Eq,(forall x. Bar n -> Rep (Bar n) x)
-> (forall x. Rep (Bar n) x -> Bar n) -> Generic (Bar n)
forall x. Rep (Bar n) x -> Bar n
forall x. Bar n -> Rep (Bar n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n x. Rep (Bar n) x -> Bar n
forall n x. Bar n -> Rep (Bar n) x
$cfrom :: forall n x. Bar n -> Rep (Bar n) x
from :: forall x. Bar n -> Rep (Bar n) x
$cto :: forall n x. Rep (Bar n) x -> Bar n
to :: forall x. Rep (Bar n) x -> Bar n
Generic,(forall a b. (a -> b) -> Bar a -> Bar b)
-> (forall a b. a -> Bar b -> Bar a) -> Functor Bar
forall a b. a -> Bar b -> Bar a
forall a b. (a -> b) -> Bar a -> Bar b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Bar a -> Bar b
fmap :: forall a b. (a -> b) -> Bar a -> Bar b
$c<$ :: forall a b. a -> Bar b -> Bar a
<$ :: forall a b. a -> Bar b -> Bar a
Functor,(forall m. Monoid m => Bar m -> m)
-> (forall m a. Monoid m => (a -> m) -> Bar a -> m)
-> (forall m a. Monoid m => (a -> m) -> Bar a -> m)
-> (forall a b. (a -> b -> b) -> b -> Bar a -> b)
-> (forall a b. (a -> b -> b) -> b -> Bar a -> b)
-> (forall b a. (b -> a -> b) -> b -> Bar a -> b)
-> (forall b a. (b -> a -> b) -> b -> Bar a -> b)
-> (forall a. (a -> a -> a) -> Bar a -> a)
-> (forall a. (a -> a -> a) -> Bar a -> a)
-> (forall a. Bar a -> [a])
-> (forall a. Bar a -> Bool)
-> (forall a. Bar a -> Int)
-> (forall a. Eq a => a -> Bar a -> Bool)
-> (forall a. Ord a => Bar a -> a)
-> (forall a. Ord a => Bar a -> a)
-> (forall a. Num a => Bar a -> a)
-> (forall a. Num a => Bar a -> a)
-> Foldable Bar
forall a. Eq a => a -> Bar a -> Bool
forall a. Num a => Bar a -> a
forall a. Ord a => Bar a -> a
forall m. Monoid m => Bar m -> m
forall a. Bar a -> Bool
forall a. Bar a -> Int
forall a. Bar a -> [a]
forall a. (a -> a -> a) -> Bar a -> a
forall m a. Monoid m => (a -> m) -> Bar a -> m
forall b a. (b -> a -> b) -> b -> Bar a -> b
forall a b. (a -> b -> b) -> b -> Bar a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Bar m -> m
fold :: forall m. Monoid m => Bar m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Bar a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Bar a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Bar a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Bar a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Bar a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Bar a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Bar a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Bar a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Bar a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Bar a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Bar a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Bar a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Bar a -> a
foldr1 :: forall a. (a -> a -> a) -> Bar a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Bar a -> a
foldl1 :: forall a. (a -> a -> a) -> Bar a -> a
$ctoList :: forall a. Bar a -> [a]
toList :: forall a. Bar a -> [a]
$cnull :: forall a. Bar a -> Bool
null :: forall a. Bar a -> Bool
$clength :: forall a. Bar a -> Int
length :: forall a. Bar a -> Int
$celem :: forall a. Eq a => a -> Bar a -> Bool
elem :: forall a. Eq a => a -> Bar a -> Bool
$cmaximum :: forall a. Ord a => Bar a -> a
maximum :: forall a. Ord a => Bar a -> a
$cminimum :: forall a. Ord a => Bar a -> a
minimum :: forall a. Ord a => Bar a -> a
$csum :: forall a. Num a => Bar a -> a
sum :: forall a. Num a => Bar a -> a
$cproduct :: forall a. Num a => Bar a -> a
product :: forall a. Num a => Bar a -> a
Foldable,Functor Bar
Foldable Bar
(Functor Bar, Foldable Bar) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Bar a -> f (Bar b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Bar (f a) -> f (Bar a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Bar a -> m (Bar b))
-> (forall (m :: * -> *) a. Monad m => Bar (m a) -> m (Bar a))
-> Traversable Bar
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Bar (m a) -> m (Bar a)
forall (f :: * -> *) a. Applicative f => Bar (f a) -> f (Bar a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bar a -> m (Bar b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bar a -> f (Bar b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bar a -> f (Bar b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bar a -> f (Bar b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Bar (f a) -> f (Bar a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Bar (f a) -> f (Bar a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bar a -> m (Bar b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bar a -> m (Bar b)
$csequence :: forall (m :: * -> *) a. Monad m => Bar (m a) -> m (Bar a)
sequence :: forall (m :: * -> *) a. Monad m => Bar (m a) -> m (Bar a)
Traversable)
makeLenses ''Bar
instance Default (Bar n) where def :: Bar n
def = [n] -> Bar n
forall n. [n] -> Bar n
bar []
instance Snoc (Bar n) (Bar n) n n where
    _Snoc :: Prism (Bar n) (Bar n) (Bar n, n) (Bar n, n)
_Snoc = ((Bar n, n) -> Bar n)
-> (Bar n -> Either (Bar n) (Bar n, n))
-> Prism (Bar n) (Bar n) (Bar n, n) (Bar n, n)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (\(Bar n
b,n
n) -> ASetter (Bar n) (Bar n) (Seq n) (Seq n)
-> (Seq n -> Seq n) -> Bar n -> Bar n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Bar n) (Bar n) (Seq n) (Seq n)
forall n n (f :: * -> *).
Functor f =>
(Seq n -> f (Seq n)) -> Bar n -> f (Bar n)
bNotes (AReview (Seq n) (Seq n, n) -> (Seq n, n) -> Seq n
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview (Seq n) (Seq n, n)
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
Prism (Seq n) (Seq n) (Seq n, n) (Seq n, n)
_Snoc ((Seq n, n) -> Seq n) -> (Seq n -> (Seq n, n)) -> Seq n -> Seq n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,n
n)) Bar n
b) ((Bar n -> Either (Bar n) (Bar n, n))
 -> Prism (Bar n) (Bar n) (Bar n, n) (Bar n, n))
-> (Bar n -> Either (Bar n) (Bar n, n))
-> Prism (Bar n) (Bar n) (Bar n, n) (Bar n, n)
forall a b. (a -> b) -> a -> b
$
            \Bar n
b -> case Getting (Leftmost (Seq n, n)) (Seq n) (Seq n, n)
-> Seq n -> Maybe (Seq n, n)
forall a s. Getting (Leftmost a) s a -> s -> Maybe a
firstOf Getting (Leftmost (Seq n, n)) (Seq n) (Seq n, n)
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
Prism (Seq n) (Seq n) (Seq n, n) (Seq n, n)
_Snoc (Getting (Seq n) (Bar n) (Seq n) -> Bar n -> Seq n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Seq n) (Bar n) (Seq n)
forall n n (f :: * -> *).
Functor f =>
(Seq n -> f (Seq n)) -> Bar n -> f (Bar n)
bNotes Bar n
b) of
                    Maybe (Seq n, n)
Nothing -> Bar n -> Either (Bar n) (Bar n, n)
forall a b. a -> Either a b
Left (Bar n
forall a. Default a => a
def :: Bar n)
                    (Just (Seq n
as,n
a)) -> (Bar n, n) -> Either (Bar n) (Bar n, n)
forall a b. b -> Either a b
Right (ASetter (Bar n) (Bar n) (Seq n) (Seq n) -> Seq n -> Bar n -> Bar n
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Bar n) (Bar n) (Seq n) (Seq n)
forall n n (f :: * -> *).
Functor f =>
(Seq n -> f (Seq n)) -> Bar n -> f (Bar n)
bNotes Seq n
as Bar n
b,n
a)
instance Cons (Bar n) (Bar n) n n where
    _Cons :: Prism (Bar n) (Bar n) (n, Bar n) (n, Bar n)
_Cons = ((n, Bar n) -> Bar n)
-> (Bar n -> Either (Bar n) (n, Bar n))
-> Prism (Bar n) (Bar n) (n, Bar n) (n, Bar n)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (\(n
n,Bar n
b) -> ASetter (Bar n) (Bar n) (Seq n) (Seq n)
-> (Seq n -> Seq n) -> Bar n -> Bar n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Bar n) (Bar n) (Seq n) (Seq n)
forall n n (f :: * -> *).
Functor f =>
(Seq n -> f (Seq n)) -> Bar n -> f (Bar n)
bNotes (AReview (Seq n) (n, Seq n) -> (n, Seq n) -> Seq n
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview (Seq n) (n, Seq n)
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
Prism (Seq n) (Seq n) (n, Seq n) (n, Seq n)
_Cons ((n, Seq n) -> Seq n) -> (Seq n -> (n, Seq n)) -> Seq n -> Seq n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n
n,)) Bar n
b) ((Bar n -> Either (Bar n) (n, Bar n))
 -> Prism (Bar n) (Bar n) (n, Bar n) (n, Bar n))
-> (Bar n -> Either (Bar n) (n, Bar n))
-> Prism (Bar n) (Bar n) (n, Bar n) (n, Bar n)
forall a b. (a -> b) -> a -> b
$
            \Bar n
b -> case Getting (Leftmost (n, Seq n)) (Seq n) (n, Seq n)
-> Seq n -> Maybe (n, Seq n)
forall a s. Getting (Leftmost a) s a -> s -> Maybe a
firstOf Getting (Leftmost (n, Seq n)) (Seq n) (n, Seq n)
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
Prism (Seq n) (Seq n) (n, Seq n) (n, Seq n)
_Cons (Getting (Seq n) (Bar n) (Seq n) -> Bar n -> Seq n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Seq n) (Bar n) (Seq n)
forall n n (f :: * -> *).
Functor f =>
(Seq n -> f (Seq n)) -> Bar n -> f (Bar n)
bNotes Bar n
b) of
                    Maybe (n, Seq n)
Nothing -> Bar n -> Either (Bar n) (n, Bar n)
forall a b. a -> Either a b
Left (Bar n
forall a. Default a => a
def :: Bar n)
                    (Just (n
a,Seq n
as)) -> (n, Bar n) -> Either (Bar n) (n, Bar n)
forall a b. b -> Either a b
Right (n
a,ASetter (Bar n) (Bar n) (Seq n) (Seq n) -> Seq n -> Bar n -> Bar n
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Bar n) (Bar n) (Seq n) (Seq n)
forall n n (f :: * -> *).
Functor f =>
(Seq n -> f (Seq n)) -> Bar n -> f (Bar n)
bNotes Seq n
as Bar n
b)
instance HasRehearsalMark (Bar n) where rehearsalMark :: Lens' (Bar n) (Maybe RehearsalMark)
rehearsalMark = (Maybe RehearsalMark -> f (Maybe RehearsalMark))
-> Bar n -> f (Bar n)
forall n (f :: * -> *).
Functor f =>
(Maybe RehearsalMark -> f (Maybe RehearsalMark))
-> Bar n -> f (Bar n)
bRehearsalMark
instance HasDirection (Bar n) where direction :: Lens' (Bar n) (Maybe Direction)
direction = (Maybe Direction -> f (Maybe Direction)) -> Bar n -> f (Bar n)
forall n (f :: * -> *).
Functor f =>
(Maybe Direction -> f (Maybe Direction)) -> Bar n -> f (Bar n)
bDirection
instance HasBarline (Bar n) where barline :: Lens' (Bar n) (Maybe Barline)
barline = (Maybe Barline -> f (Maybe Barline)) -> Bar n -> f (Bar n)
forall n (f :: * -> *).
Functor f =>
(Maybe Barline -> f (Maybe Barline)) -> Bar n -> f (Bar n)
bBarline
instance HasTimeSignature (Bar n) where timeSignature :: Lens' (Bar n) (Maybe TimeSignature)
timeSignature = (Maybe TimeSignature -> f (Maybe TimeSignature))
-> Bar n -> f (Bar n)
forall n (f :: * -> *).
Functor f =>
(Maybe TimeSignature -> f (Maybe TimeSignature))
-> Bar n -> f (Bar n)
bTimeSignature
instance HasClef (Bar n) where clef :: Lens' (Bar n) (Maybe Clef)
clef = (Maybe Clef -> f (Maybe Clef)) -> Bar n -> f (Bar n)
forall n (f :: * -> *).
Functor f =>
(Maybe Clef -> f (Maybe Clef)) -> Bar n -> f (Bar n)
bClef
instance HasRepeats (Bar n) where repeats :: Lens' (Bar n) (Maybe Repeats)
repeats = (Maybe Repeats -> f (Maybe Repeats)) -> Bar n -> f (Bar n)
forall n (f :: * -> *).
Functor f =>
(Maybe Repeats -> f (Maybe Repeats)) -> Bar n -> f (Bar n)
bRepeats
instance (Show n) => Show (Bar n) where
    show :: Bar n -> String
show Bar n
b = Bar n -> String -> [Bar n -> String] -> String
forall s. s -> String -> [s -> String] -> String
mshows Bar n
b (String
"bar " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [n] -> String
forall a. Show a => a -> String
show (Seq n -> [n]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq n -> [n]) -> Seq n -> [n]
forall a b. (a -> b) -> a -> b
$ Getting (Seq n) (Bar n) (Seq n) -> Bar n -> Seq n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Seq n) (Bar n) (Seq n)
forall n n (f :: * -> *).
Functor f =>
(Seq n -> f (Seq n)) -> Bar n -> f (Bar n)
bNotes Bar n
b))
             [Getter (Bar n) (Maybe RehearsalMark) -> String -> Bar n -> String
forall a s. Show a => Getter s (Maybe a) -> String -> s -> String
mshow (Maybe RehearsalMark -> f (Maybe RehearsalMark))
-> Bar n -> f (Bar n)
forall a. HasRehearsalMark a => Lens' a (Maybe RehearsalMark)
Lens' (Bar n) (Maybe RehearsalMark)
Getter (Bar n) (Maybe RehearsalMark)
rehearsalMark String
"rehearsalMark"
             ,Getter (Bar n) (Maybe Direction) -> String -> Bar n -> String
forall a s. Show a => Getter s (Maybe a) -> String -> s -> String
mshow (Maybe Direction -> f (Maybe Direction)) -> Bar n -> f (Bar n)
forall a. HasDirection a => Lens' a (Maybe Direction)
Lens' (Bar n) (Maybe Direction)
Getter (Bar n) (Maybe Direction)
direction String
"direction"
             ,Getter (Bar n) (Maybe Barline) -> String -> Bar n -> String
forall a s. Show a => Getter s (Maybe a) -> String -> s -> String
mshow (Maybe Barline -> f (Maybe Barline)) -> Bar n -> f (Bar n)
forall a. HasBarline a => Lens' a (Maybe Barline)
Lens' (Bar n) (Maybe Barline)
Getter (Bar n) (Maybe Barline)
barline String
"barline"
             ,Getter (Bar n) (Maybe Repeats) -> String -> Bar n -> String
forall a s. Show a => Getter s (Maybe a) -> String -> s -> String
mshow (Maybe Repeats -> f (Maybe Repeats)) -> Bar n -> f (Bar n)
forall a. HasRepeats a => Lens' a (Maybe Repeats)
Lens' (Bar n) (Maybe Repeats)
Getter (Bar n) (Maybe Repeats)
repeats String
"repeat"
             ,Getter (Bar n) (Maybe TimeSignature) -> String -> Bar n -> String
forall a s. Show a => Getter s (Maybe a) -> String -> s -> String
mshow (Maybe TimeSignature -> f (Maybe TimeSignature))
-> Bar n -> f (Bar n)
forall a. HasTimeSignature a => Lens' a (Maybe TimeSignature)
Lens' (Bar n) (Maybe TimeSignature)
Getter (Bar n) (Maybe TimeSignature)
timeSignature String
"timeSignature"
             ,Getter (Bar n) (Maybe Clef) -> String -> Bar n -> String
forall a s. Show a => Getter s (Maybe a) -> String -> s -> String
mshow (Maybe Clef -> f (Maybe Clef)) -> Bar n -> f (Bar n)
forall a. HasClef a => Lens' a (Maybe Clef)
Lens' (Bar n) (Maybe Clef)
Getter (Bar n) (Maybe Clef)
clef String
"clef"
             ]
instance Semigroup (Bar n) where
    Bar n
a <> :: Bar n -> Bar n -> Bar n
<> Bar n
b = ASetter (Bar n) (Bar n) (Seq n) (Seq n)
-> (Seq n -> Seq n) -> Bar n -> Bar n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Bar n) (Bar n) (Seq n) (Seq n)
forall n n (f :: * -> *).
Functor f =>
(Seq n -> f (Seq n)) -> Bar n -> f (Bar n)
bNotes (Seq n -> Seq n -> Seq n
forall a. Semigroup a => a -> a -> a
<> Getting (Seq n) (Bar n) (Seq n) -> Bar n -> Seq n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Seq n) (Bar n) (Seq n)
forall n n (f :: * -> *).
Functor f =>
(Seq n -> f (Seq n)) -> Bar n -> f (Bar n)
bNotes Bar n
b) Bar n
a
instance Monoid (Bar n) where
    mempty :: Bar n
mempty = Bar n
forall a. Default a => a
def
    mappend :: Bar n -> Bar n -> Bar n
mappend = Bar n -> Bar n -> Bar n
forall a. Semigroup a => a -> a -> a
(<>)

-- | Bar smart ctor, used in 'Show'.
bar :: [n] -> Bar n
bar :: forall n. [n] -> Bar n
bar [n]
ns = Seq n
-> Maybe RehearsalMark
-> Maybe Direction
-> Maybe Barline
-> Maybe Repeats
-> Maybe TimeSignature
-> Maybe Clef
-> Bar n
forall n.
Seq n
-> Maybe RehearsalMark
-> Maybe Direction
-> Maybe Barline
-> Maybe Repeats
-> Maybe TimeSignature
-> Maybe Clef
-> Bar n
Bar ([n] -> Seq n
forall a. [a] -> Seq a
fromList [n]
ns) Maybe RehearsalMark
forall a. Maybe a
Nothing Maybe Direction
forall a. Maybe a
Nothing Maybe Barline
forall a. Maybe a
Nothing Maybe Repeats
forall a. Maybe a
Nothing Maybe TimeSignature
forall a. Maybe a
Nothing Maybe Clef
forall a. Maybe a
Nothing

testBar :: Bar (Note [Int] Int)
testBar :: Bar (Note [Int] Int)
testBar = [Note [Int] Int] -> Bar (Note [Int] Int)
forall n. [n] -> Bar n
bar [[Int
60][Int] -> Int -> Note [Int] Int
forall p d. p -> d -> Note p d
|:Int
2,[Int
62][Int] -> Int -> Note [Int] Int
forall p d. p -> d -> Note p d
|:Int
1] Bar (Note [Int] Int)
-> (Bar (Note [Int] Int) -> Bar (Note [Int] Int))
-> Bar (Note [Int] Int)
forall a b. a -> (a -> b) -> b
& (Maybe TimeSignature -> Identity (Maybe TimeSignature))
-> Bar (Note [Int] Int) -> Identity (Bar (Note [Int] Int))
forall a. HasTimeSignature a => Lens' a (Maybe TimeSignature)
Lens' (Bar (Note [Int] Int)) (Maybe TimeSignature)
timeSignature ((Maybe TimeSignature -> Identity (Maybe TimeSignature))
 -> Bar (Note [Int] Int) -> Identity (Bar (Note [Int] Int)))
-> TimeSignature -> Bar (Note [Int] Int) -> Bar (Note [Int] Int)
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int -> Quanta -> TimeSignature
TimeSignature Int
4 Quanta
Q4 Bar (Note [Int] Int)
-> (Bar (Note [Int] Int) -> Bar (Note [Int] Int))
-> Bar (Note [Int] Int)
forall a b. a -> (a -> b) -> b
& (Maybe Direction -> Identity (Maybe Direction))
-> Bar (Note [Int] Int) -> Identity (Bar (Note [Int] Int))
forall a. HasDirection a => Lens' a (Maybe Direction)
Lens' (Bar (Note [Int] Int)) (Maybe Direction)
direction ((Maybe Direction -> Identity (Maybe Direction))
 -> Bar (Note [Int] Int) -> Identity (Bar (Note [Int] Int)))
-> Direction -> Bar (Note [Int] Int) -> Bar (Note [Int] Int)
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Direction
"Softly"