module Bang.Music.Class where
import Prelude hiding(foldr)
import Data.Ratio
import Data.Monoid
import Data.Foldable
import Data.Bifunctor
import Data.Bifoldable
type Dur = Rational
data Primitive d a =
Note {dur :: d, ntype :: a}
| Rest {dur :: d}
deriving (Show, Eq)
instance Functor (Primitive dur) where
fmap f (Note d a) = Note d (f a)
fmap f (Rest d) = Rest d
data Music dur a =
Prim (Primitive dur a)
| Music dur a :+: Music dur a
| Music dur a :=: Music dur a
| Modify Control (Music dur a)
deriving (Show, Eq)
data Control =
BPM Integer
| Tempo Rational
| Instrument InstrumentName
deriving (Show, Eq)
instance Num dur => Monoid (Music dur a) where
mappend = (:+:)
mempty = Prim (Rest 0)
instance Functor (Music dur) where
fmap f (Prim m) = Prim (fmap f m)
fmap f (a :+: b) = fmap f a :+: fmap f b
fmap f (a :=: b) = fmap f a :=: fmap f b
fmap f (Modify c a) = Modify c (fmap f a)
instance Bifunctor Music where
bimap f g (Prim (Note dur a)) = Prim $ Note (f dur) (g a)
bimap f g (Prim (Rest dur)) = Prim $ Rest (f dur)
bimap f g (a :+: b) = bimap f g a :+: bimap f g b
bimap f g (a :=: b) = bimap f g a :=: bimap f g b
bimap f g (Modify c a) = Modify c (bimap f g a)
instance Foldable (Music dur) where
foldMap f (Prim (Rest _)) = mempty
foldMap f (Prim (Note _ a)) = f a
foldMap f (a :+: b) = foldMap f a `mappend` foldMap f b
foldMap f (a :=: b) = foldMap f a `mappend` foldMap f b
foldMap f (Modify c a) = foldMap f a
instance Bifoldable Music where
bifoldMap f g (Prim (Note dur a)) = f dur `mappend` g a
bifoldMap f g (Prim (Rest dur)) = f dur
bifoldMap f g (a :+: b) = bifoldMap f g a `mappend` bifoldMap f g b
bifoldMap f g (a :=: b) = bifoldMap f g a `mappend` bifoldMap f g b
bifoldMap f g (Modify c a) = bifoldMap f g a
data InstrumentName = DrumSet
deriving (Show, Eq)
duration :: (Fractional a, Ord a) => Music a b -> a
duration (a :+: b) = duration a + duration b
duration (a :=: b) = max (duration a) (duration b)
duration (Modify (Tempo n) m) = duration (first (* fromRational n) m)
duration (Modify _ m) = duration m
duration (Prim (Note d a)) = d
duration (Prim (Rest d)) = d
cappend :: Music dur a -> Music dur a -> Music dur a
cappend = (:=:)
cempty :: Num dur => Music dur a
cempty = Prim (Rest 0)
cconcat :: Num dur => [Music dur a] -> Music dur a
cconcat = foldr cappend cempty