fadno-1.1.0: Minimal library for music generation and notation

Safe HaskellNone
LanguageHaskell2010

Fadno.Notation

Synopsis

Documentation

class HasTimeSignature a where Source #

Minimal complete definition

timeSignature

data PPQ Source #

Constructors

PQ4 
PQ8 
PQ16 
PQ32 
PQ64 
PQ128 
PQ256 

Instances

Bounded PPQ Source # 

Methods

minBound :: PPQ #

maxBound :: PPQ #

Enum PPQ Source # 

Methods

succ :: PPQ -> PPQ #

pred :: PPQ -> PPQ #

toEnum :: Int -> PPQ #

fromEnum :: PPQ -> Int #

enumFrom :: PPQ -> [PPQ] #

enumFromThen :: PPQ -> PPQ -> [PPQ] #

enumFromTo :: PPQ -> PPQ -> [PPQ] #

enumFromThenTo :: PPQ -> PPQ -> PPQ -> [PPQ] #

Eq PPQ Source # 

Methods

(==) :: PPQ -> PPQ -> Bool #

(/=) :: PPQ -> PPQ -> Bool #

Ord PPQ Source # 

Methods

compare :: PPQ -> PPQ -> Ordering #

(<) :: PPQ -> PPQ -> Bool #

(<=) :: PPQ -> PPQ -> Bool #

(>) :: PPQ -> PPQ -> Bool #

(>=) :: PPQ -> PPQ -> Bool #

max :: PPQ -> PPQ -> PPQ #

min :: PPQ -> PPQ -> PPQ #

Show PPQ Source # 

Methods

showsPrec :: Int -> PPQ -> ShowS #

show :: PPQ -> String #

showList :: [PPQ] -> ShowS #

ppqDiv :: Integral a => PPQ -> a Source #

ratioPPQ :: Integral a => PPQ -> Iso' a Rational Source #

Duration iso, from Integral to Rational, given PPQ

adaptHas :: Lens' a (Maybe a) Source #

Adapt a type to its HasXXX "Maybe Lens'"

adaptHasLens :: Lens' s a -> Lens' s (Maybe a) Source #

Adapt a non-Maybe lens to the HasXXX "Maybe Lens'"

adaptHasNot :: Lens' s (Maybe a) Source #

Adapt a type that does NOT support the HasXXX feature.

data Tie Source #

Tied notes.

Constructors

TStart 
TStop 
TBoth 

Instances

Bounded Tie Source # 

Methods

minBound :: Tie #

maxBound :: Tie #

Enum Tie Source # 

Methods

succ :: Tie -> Tie #

pred :: Tie -> Tie #

toEnum :: Int -> Tie #

fromEnum :: Tie -> Int #

enumFrom :: Tie -> [Tie] #

enumFromThen :: Tie -> Tie -> [Tie] #

enumFromTo :: Tie -> Tie -> [Tie] #

enumFromThenTo :: Tie -> Tie -> Tie -> [Tie] #

Eq Tie Source # 

Methods

(==) :: Tie -> Tie -> Bool #

(/=) :: Tie -> Tie -> Bool #

Ord Tie Source # 

Methods

compare :: Tie -> Tie -> Ordering #

(<) :: Tie -> Tie -> Bool #

(<=) :: Tie -> Tie -> Bool #

(>) :: Tie -> Tie -> Bool #

(>=) :: Tie -> Tie -> Bool #

max :: Tie -> Tie -> Tie #

min :: Tie -> Tie -> Tie #

Show Tie Source # 

Methods

showsPrec :: Int -> Tie -> ShowS #

show :: Tie -> String #

showList :: [Tie] -> ShowS #

HasTie Tie Source # 

Methods

tie :: Lens' Tie (Maybe Tie) Source #

class HasTie a where Source #

Minimal complete definition

tie

Methods

tie :: Lens' a (Maybe Tie) Source #

Instances

HasTie Tie Source # 

Methods

tie :: Lens' Tie (Maybe Tie) Source #

HasTie (Note p d) Source # 

Methods

tie :: Lens' (Note p d) (Maybe Tie) Source #

HasTie (Note' p d) Source # 

Methods

tie :: Lens' (Note' p d) (Maybe Tie) Source #

data Slur Source #

Slurred notes.

Constructors

SStart 
SStop 

Instances

Bounded Slur Source # 
Enum Slur Source # 

Methods

succ :: Slur -> Slur #

pred :: Slur -> Slur #

toEnum :: Int -> Slur #

fromEnum :: Slur -> Int #

enumFrom :: Slur -> [Slur] #

enumFromThen :: Slur -> Slur -> [Slur] #

enumFromTo :: Slur -> Slur -> [Slur] #

enumFromThenTo :: Slur -> Slur -> Slur -> [Slur] #

Eq Slur Source # 

Methods

(==) :: Slur -> Slur -> Bool #

(/=) :: Slur -> Slur -> Bool #

Ord Slur Source # 

Methods

compare :: Slur -> Slur -> Ordering #

(<) :: Slur -> Slur -> Bool #

(<=) :: Slur -> Slur -> Bool #

(>) :: Slur -> Slur -> Bool #

(>=) :: Slur -> Slur -> Bool #

max :: Slur -> Slur -> Slur #

min :: Slur -> Slur -> Slur #

Show Slur Source # 

Methods

showsPrec :: Int -> Slur -> ShowS #

show :: Slur -> String #

showList :: [Slur] -> ShowS #

HasSlur Slur Source # 

class HasSlur a where Source #

Minimal complete definition

slur

Methods

slur :: Lens' a (Maybe Slur) Source #

Instances

newtype RehearsalMark Source #

Bar rehearsal mark.

Constructors

RehearsalMark 

Instances

Eq RehearsalMark Source # 
Ord RehearsalMark Source # 
Show RehearsalMark Source # 
IsString RehearsalMark Source # 
Generic RehearsalMark Source # 

Associated Types

type Rep RehearsalMark :: * -> * #

Monoid RehearsalMark Source # 
Default RehearsalMark Source # 

Methods

def :: RehearsalMark #

HasRehearsalMark RehearsalMark Source # 
type Rep RehearsalMark Source # 
type Rep RehearsalMark = D1 (MetaData "RehearsalMark" "Fadno.Notation" "fadno-1.1.0-IVrIm4FFo3O5PLjIKfq2zI" True) (C1 (MetaCons "RehearsalMark" PrefixI True) (S1 (MetaSel (Just Symbol "_rehearsalText") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String)))

data Barline Source #

Barline.

Constructors

Double 
Final 

Instances

Eq Barline Source # 

Methods

(==) :: Barline -> Barline -> Bool #

(/=) :: Barline -> Barline -> Bool #

Ord Barline Source # 
Show Barline Source # 
Generic Barline Source # 

Associated Types

type Rep Barline :: * -> * #

Methods

from :: Barline -> Rep Barline x #

to :: Rep Barline x -> Barline #

HasBarline Barline Source # 
type Rep Barline Source # 
type Rep Barline = D1 (MetaData "Barline" "Fadno.Notation" "fadno-1.1.0-IVrIm4FFo3O5PLjIKfq2zI" False) ((:+:) (C1 (MetaCons "Double" PrefixI False) U1) (C1 (MetaCons "Final" PrefixI False) U1))

class HasBarline a where Source #

Minimal complete definition

barline

data Repeats Source #

Constructors

RStart 
REnd 
RBoth 

Instances

Eq Repeats Source # 

Methods

(==) :: Repeats -> Repeats -> Bool #

(/=) :: Repeats -> Repeats -> Bool #

Ord Repeats Source # 
Show Repeats Source # 
Generic Repeats Source # 

Associated Types

type Rep Repeats :: * -> * #

Methods

from :: Repeats -> Rep Repeats x #

to :: Rep Repeats x -> Repeats #

HasRepeats Repeats Source # 
type Rep Repeats Source # 
type Rep Repeats = D1 (MetaData "Repeats" "Fadno.Notation" "fadno-1.1.0-IVrIm4FFo3O5PLjIKfq2zI" False) ((:+:) (C1 (MetaCons "RStart" PrefixI False) U1) ((:+:) (C1 (MetaCons "REnd" PrefixI False) U1) (C1 (MetaCons "RBoth" PrefixI False) U1)))

class HasRepeats a where Source #

Minimal complete definition

repeats

data Clef Source #

Instances

Eq Clef Source # 

Methods

(==) :: Clef -> Clef -> Bool #

(/=) :: Clef -> Clef -> Bool #

Ord Clef Source # 

Methods

compare :: Clef -> Clef -> Ordering #

(<) :: Clef -> Clef -> Bool #

(<=) :: Clef -> Clef -> Bool #

(>) :: Clef -> Clef -> Bool #

(>=) :: Clef -> Clef -> Bool #

max :: Clef -> Clef -> Clef #

min :: Clef -> Clef -> Clef #

Show Clef Source # 

Methods

showsPrec :: Int -> Clef -> ShowS #

show :: Clef -> String #

showList :: [Clef] -> ShowS #

Generic Clef Source # 

Associated Types

type Rep Clef :: * -> * #

Methods

from :: Clef -> Rep Clef x #

to :: Rep Clef x -> Clef #

HasClef Clef Source # 
type Rep Clef Source # 
type Rep Clef = D1 (MetaData "Clef" "Fadno.Notation" "fadno-1.1.0-IVrIm4FFo3O5PLjIKfq2zI" False) ((:+:) ((:+:) (C1 (MetaCons "TrebleClef" PrefixI False) U1) (C1 (MetaCons "BassClef" PrefixI False) U1)) ((:+:) (C1 (MetaCons "AltoClef" PrefixI False) U1) (C1 (MetaCons "PercClef" PrefixI False) U1)))

class HasClef a where Source #

Minimal complete definition

clef

Methods

clef :: Lens' a (Maybe Clef) Source #

Instances

newtype Part a Source #

Part identifier, prefers Num or IsString values.

Constructors

Part 

Fields

Instances

Functor Part Source # 

Methods

fmap :: (a -> b) -> Part a -> Part b #

(<$) :: a -> Part b -> Part a #

Foldable Part Source # 

Methods

fold :: Monoid m => Part m -> m #

foldMap :: Monoid m => (a -> m) -> Part a -> m #

foldr :: (a -> b -> b) -> b -> Part a -> b #

foldr' :: (a -> b -> b) -> b -> Part a -> b #

foldl :: (b -> a -> b) -> b -> Part a -> b #

foldl' :: (b -> a -> b) -> b -> Part a -> b #

foldr1 :: (a -> a -> a) -> Part a -> a #

foldl1 :: (a -> a -> a) -> Part a -> a #

toList :: Part a -> [a] #

null :: Part a -> Bool #

length :: Part a -> Int #

elem :: Eq a => a -> Part a -> Bool #

maximum :: Ord a => Part a -> a #

minimum :: Ord a => Part a -> a #

sum :: Num a => Part a -> a #

product :: Num a => Part a -> a #

Traversable Part Source # 

Methods

traverse :: Applicative f => (a -> f b) -> Part a -> f (Part b) #

sequenceA :: Applicative f => Part (f a) -> f (Part a) #

mapM :: Monad m => (a -> m b) -> Part a -> m (Part b) #

sequence :: Monad m => Part (m a) -> m (Part a) #

Bounded a => Bounded (Part a) Source # 

Methods

minBound :: Part a #

maxBound :: Part a #

Eq a => Eq (Part a) Source # 

Methods

(==) :: Part a -> Part a -> Bool #

(/=) :: Part a -> Part a -> Bool #

Num a => Num (Part a) Source # 

Methods

(+) :: Part a -> Part a -> Part a #

(-) :: Part a -> Part a -> Part a #

(*) :: Part a -> Part a -> Part a #

negate :: Part a -> Part a #

abs :: Part a -> Part a #

signum :: Part a -> Part a #

fromInteger :: Integer -> Part a #

Ord a => Ord (Part a) Source # 

Methods

compare :: 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 #

max :: Part a -> Part a -> Part a #

min :: Part a -> Part a -> Part a #

Real a => Real (Part a) Source # 

Methods

toRational :: Part a -> Rational #

Show a => Show (Part a) Source # 

Methods

showsPrec :: Int -> Part a -> ShowS #

show :: Part a -> String #

showList :: [Part a] -> ShowS #

IsString a => IsString (Part a) Source # 

Methods

fromString :: String -> Part a #

Generic (Part a) Source # 

Associated Types

type Rep (Part a) :: * -> * #

Methods

from :: Part a -> Rep (Part a) x #

to :: Rep (Part a) x -> Part a #

type Rep (Part a) Source # 
type Rep (Part a) = D1 (MetaData "Part" "Fadno.Notation" "fadno-1.1.0-IVrIm4FFo3O5PLjIKfq2zI" True) (C1 (MetaCons "Part" PrefixI True) (S1 (MetaSel (Just Symbol "_partIdx") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)))

partIdx :: forall a a. Iso (Part a) (Part a) a a Source #

class HasPart a b | a -> b where Source #

Minimal complete definition

part

Methods

part :: Lens' a (Maybe (Part b)) Source #

mshow :: Show a => Getter s (Maybe a) -> String -> s -> String Source #

Lensy show of a Maybe field, given a Getter and its name.

mshows :: s -> String -> [s -> String] -> String Source #

concatMap show functions with a prelude.

data Note' p d Source #

Note with notations.

Constructors

Note' 

Instances

(Eq p, Eq d) => Eq (Note' p d) Source # 

Methods

(==) :: Note' p d -> Note' p d -> Bool #

(/=) :: Note' p d -> Note' p d -> Bool #

(Show p, Show d) => Show (Note' p d) Source # 

Methods

showsPrec :: Int -> Note' p d -> ShowS #

show :: Note' p d -> String #

showList :: [Note' p d] -> ShowS #

Generic (Note' p d) Source # 

Associated Types

type Rep (Note' p d) :: * -> * #

Methods

from :: Note' p d -> Rep (Note' p d) x #

to :: Rep (Note' p d) x -> Note' p d #

HasTie (Note' p d) Source # 

Methods

tie :: Lens' (Note' p d) (Maybe Tie) Source #

HasArticulation (Note' p d) Source # 
HasSlur (Note' p d) Source # 

Methods

slur :: Lens' (Note' p d) (Maybe Slur) Source #

HasNote (Note' p d) p d Source # 

Methods

note :: Lens' (Note' p d) (Note p d) Source #

fromNote :: HasNote n p d => n -> Note' p d Source #

notePitch :: Lens' (Note' p d) p Source #

noteDur :: Lens' (Note' p d) d Source #

type Rep (Note' p d) Source # 

nTie :: forall p d. Lens' (Note' p d) (Maybe Tie) Source #

nSlur :: forall p d. Lens' (Note' p d) (Maybe Slur) Source #

nNote :: forall p d p d. Lens (Note' p d) (Note' p d) (Note p d) (Note p d) Source #

note' :: Note p d -> Note' p d Source #

Note smart ctor, used in Show.

data Bar n Source #

Bar as list of notes, with notations.

Instances

Functor Bar Source # 

Methods

fmap :: (a -> b) -> Bar a -> Bar b #

(<$) :: a -> Bar b -> Bar a #

Foldable Bar Source # 

Methods

fold :: Monoid m => Bar m -> m #

foldMap :: Monoid m => (a -> m) -> Bar a -> m #

foldr :: (a -> b -> b) -> b -> Bar a -> b #

foldr' :: (a -> b -> b) -> b -> Bar a -> b #

foldl :: (b -> a -> b) -> b -> Bar a -> b #

foldl' :: (b -> a -> b) -> b -> Bar a -> b #

foldr1 :: (a -> a -> a) -> Bar a -> a #

foldl1 :: (a -> a -> a) -> Bar a -> a #

toList :: Bar a -> [a] #

null :: Bar a -> Bool #

length :: Bar a -> Int #

elem :: Eq a => a -> Bar a -> Bool #

maximum :: Ord a => Bar a -> a #

minimum :: Ord a => Bar a -> a #

sum :: Num a => Bar a -> a #

product :: Num a => Bar a -> a #

Traversable Bar Source # 

Methods

traverse :: Applicative f => (a -> f b) -> Bar a -> f (Bar b) #

sequenceA :: Applicative f => Bar (f a) -> f (Bar a) #

mapM :: Monad m => (a -> m b) -> Bar a -> m (Bar b) #

sequence :: Monad m => Bar (m a) -> m (Bar a) #

Eq n => Eq (Bar n) Source # 

Methods

(==) :: Bar n -> Bar n -> Bool #

(/=) :: Bar n -> Bar n -> Bool #

Show n => Show (Bar n) Source # 

Methods

showsPrec :: Int -> Bar n -> ShowS #

show :: Bar n -> String #

showList :: [Bar n] -> ShowS #

Generic (Bar n) Source # 

Associated Types

type Rep (Bar n) :: * -> * #

Methods

from :: Bar n -> Rep (Bar n) x #

to :: Rep (Bar n) x -> Bar n #

Monoid (Bar n) Source # 

Methods

mempty :: Bar n #

mappend :: Bar n -> Bar n -> Bar n #

mconcat :: [Bar n] -> Bar n #

Default (Bar n) Source # 

Methods

def :: Bar n #

HasTimeSignature (Bar n) Source # 
HasRehearsalMark (Bar n) Source # 
HasRepeats (Bar n) Source # 
HasBarline (Bar n) Source # 
HasDirection (Bar n) Source # 
HasClef (Bar n) Source # 

Methods

clef :: Lens' (Bar n) (Maybe Clef) Source #

Snoc (Bar n) (Bar n) n n Source # 

Methods

_Snoc :: Prism (Bar n) (Bar n) (Bar n, n) (Bar n, n) #

Cons (Bar n) (Bar n) n n Source # 

Methods

_Cons :: Prism (Bar n) (Bar n) (n, Bar n) (n, Bar n) #

type Rep (Bar n) Source # 

bRepeats :: forall n. Lens' (Bar n) (Maybe Repeats) Source #

bNotes :: forall n n. Lens (Bar n) (Bar n) (Seq n) (Seq n) Source #

bClef :: forall n. Lens' (Bar n) (Maybe Clef) Source #

bBarline :: forall n. Lens' (Bar n) (Maybe Barline) Source #

bar :: [n] -> Bar n Source #

Bar smart ctor, used in Show.