packages feed

Bang (empty) → 0.1.0.0

raw patch · 11 files changed

+1054/−0 lines, 11 filesdep +basedep +bifunctorsdep +hmidisetup-changed

Dependencies added: base, bifunctors, hmidi, mtl, transformers

Files

+ Bang.cabal view
@@ -0,0 +1,41 @@+-- Initial Bang.cabal generated by cabal init.  For further documentation, +-- see http://haskell.org/cabal/users-guide/++name:                Bang+version:             0.1.0.0+synopsis:            A Drum Machine DSL for Haskell+description:         +  This library consists of a DSL for piecing together drum compositions. It uses a MIDI backend+  and is only currently available for use on Mac OSX. Much of the library was inspired by previous work done by Yale's+  @<http://haskell.cs.yale.edu/euterpea/ Euterpea>@ project and Paul Hudak\'s @<http://cpsc.yale.edu/sites/default/files/files/tr1259.pdf paper>@.+homepage:            https://github.com/5outh/Bang/+license:             MIT+license-file:        LICENSE+author:              Benjamin Kovach+maintainer:          bkovach13@gmail.com+-- copyright:           +category:            Sound+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  exposed-modules:     Bang, +                       Bang.Interface.Base,+                       Bang.Interface.Drum,+                       Bang.Music.Class, +                       Bang.Music.Operators, +                       Bang.Music.Transform++  other-modules:       Bang.Interpreter++  -- other-modules:       +  other-extensions:    DeriveFunctor, NoMonomorphismRestriction+  build-depends:       base >=4.6 && <5, +                       mtl >=2.1 && <3, +                       transformers >=0.3 && <0.4, +                       hmidi >=0.2 && <0.3,+                       bifunctors >= 4 && <5++  hs-source-dirs:      src+  default-language:    Haskell2010
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Benjamin Kovach++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,35 @@+Bang+====++An <b>E</b>mbedded <b>D</b>omain <b>S</b>pecific <b>L</b>anguage for writing drum machine patterns in Haskell.++Bang interfaces with your system MIDI device in order to play drum compositions, directly written in and +interpreted by the Haskell programming language.++Example:++```haskell+-- | The first few measures of 'Toxicity' by System of a Down.+toxicityIntro =+  let sh = sn >< hc -- snare and closed hi-hat combo+      bc = bd >< hc -- bass and closed hi-hat combo+      cd = bd >< cc -- bass and crash cymbal combo+  in bang $ +     double $ -- play at double tempo+        bd+     <> ( double $ +          mconcat [ -- concatenate into a single sequential composition+            mconcat [sh, bd, qr, bd, sh, qr, bd, qr, sh, qr]+          , mconcat [ +              (2 #>) >>~ [sn, t1, t2] -- play each element of the list twice+            , double $ 4 #> sn+            , (2 #>) >>~ [sn, t1, t2] +            , m4 cd qr hc sn -- groups of measures with 4 beats  +            , m4 hc bd sh qr+            , m4 hc sn bc qr+            , m4 bc qr hc sh+            , m4 hc bd sh qr+            , m4 bd qr sh qr +            ] +          ] )+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Bang.hs view
@@ -0,0 +1,105 @@+{-|+Module      : Bang+Description : A Domain Specific Language for generating drum compositions+Copyright   : (c) Benjamin Kovach, 2014+License     : MIT+Maintainer  : bkovach13@gmail.com+Stability   : experimental+Portability : Mac OSX++The Bang module exports the main functions to actually play a constructed composition. You can use either 'bang' to+play a composition a single time, or 'bangR' to continuously repeat a composition /ad infinitum/.+-}+module Bang(+  bang+, bangR+, bangWith+, bangRWith+, Options(..)+, defaultOptions+, module Bang.Music+, module Bang.Interface+) where++import Control.Monad+import Control.Monad.Trans+import Control.Monad.Trans.State+import Control.Concurrent+import Data.Monoid+import System.MIDI++import Bang.Music+import Bang.Interface+import Bang.Interpreter++data Options = Options {+  o_bpm :: Integer,+  -- ^ BPM of the composition to play+  o_tempo :: Dur+  -- ^ Initial 'Tempo' of the composition to play+  } deriving (Show, Eq)++-- | Default options to 'bang' with.+--+-- > defaultOptions = Options{ o_bpm = 120, o_tempo = 1 }+defaultOptions :: Options+defaultOptions = Options{ o_bpm = 120, o_tempo = 1 }++-- | Play a composition over the first system `Destination` for MIDI events.+--+-- > bang = bangWith defaultOptions+bang :: Music Dur PercussionSound -> IO ()+bang = bangWith defaultOptions++-- | 'bang' a composition repeatedly.+--+-- > bangR = bang . mconcat . repeat+bangR :: Music Dur PercussionSound -> IO ()+bangR = bangRWith defaultOptions++-- | 'bangR' with specified 'Options'.+--+-- > bangRWith opts = bangWith opts . mconcat . repeat+bangRWith :: Options -> Music Dur PercussionSound -> IO ()+bangRWith opts = bangWith opts . mconcat . repeat++-- | 'bang' with specified 'Options'.+bangWith :: Options -> Music Dur PercussionSound -> IO ()+bangWith opts song = do+  dstlist <- enumerateDestinations+  case dstlist of +    [] -> fail "No MIDI Devices found."+    (dst:_) -> do+      name    <- getName dst+      putStrLn $ "Using MIDI device: " ++ name+      conn    <- openDestination dst+      playWith opts conn song++-- | 'play' with specified 'Options'+playWith :: Options -> Connection -> Music Dur PercussionSound -> IO ()+playWith (Options oBpm oTempo) conn song = do+  start conn+  evalStateT runComposition (conn, interpret (bpm oBpm $ tempo oTempo song))+  close conn++-- | 'play' a composition over a given 'Connection'+play :: Connection -> Music Dur PercussionSound -> IO ()+play conn song = do+  start conn+  evalStateT runComposition (conn, interpret song)+  close conn++-- | Run a composition by repeatedly updating the `Connection` and sending events as they come.+runComposition :: StateT (Connection, [Primitive Dur PercussionSound]) IO ()+runComposition = do+  (conn, evs) <- get+  t <- lift $ currentTime conn+  case evs of+    [] -> return ()+    (e@(Note _ _):xs) -> do+      let x@(MidiEvent s ev) = drumToMidiEvent e+      when (s < t) $ do+        put (conn, xs)+        lift $ send conn ev+      lift $ threadDelay 1000+      runComposition
+ src/Bang/Interface/Base.hs view
@@ -0,0 +1,88 @@+{-|+Module      : Bang.Interface.Base+Description : An interface to the basic, general musical operations in Bang+Copyright   : (c) Benjamin Kovach, 2014+License     : MIT+Maintainer  : bkovach13@gmail.com+Stability   : experimental+Portability : Mac OSX++This module exports a number of utilities for constructing primitive notes, rests, and tempo.+-}+module Bang.Interface.Base where++import Bang.Music.Class+import Data.Monoid++-- | 'Rest' for a given duration.+rest :: Dur -> Music Dur a+rest d = Prim (Rest d)++-- | Convenience constructor for single 'Note's+note :: Dur -> a -> Music Dur a+note d x = Prim (Note d x)++-- | Set the bpm of a composition+bpm :: Integer -> Music a b -> Music a b+bpm n = Modify (BPM n)++-- | Set the tempo of a composition+tempo :: Rational -> Music a b -> Music a b+tempo n = Modify (Tempo (1/n))++-- | Convenience function for concatenating four compositions together+-- sequentially. Most general type signature \'cause why not?+m4 :: Monoid a => a -> a -> a -> a -> a+m4 a b c d = mconcat [a, b, c, d]++-- | Quadruple the tempo of a composition.+quad :: Music a b -> Music a b+quad = tempo 4++-- | Double the tempo of a composition.+double :: Music a b -> Music a b+double = tempo 2++-- | Set the tempo of a composition to 1 (default, typically idempotent).+normal :: Music a b -> Music a b+normal = tempo 1++-- | Half the tempo of a composition.+half :: Music a b -> Music a b+half = tempo (1/2)++-- | Quarter the tempo of a composition.+quarter :: Music a b -> Music a b+quarter = tempo (1/4)++-- | Convenience constructor for smashing `n` values into a single 1-duration measure.+tuplets :: Rational -> Music a b -> Music a b+tuplets n = tempo (n/4)++-- | Play 3 notes per measure.+triplets :: Music a b -> Music a b+triplets = tuplets 3++-- | Play 5 notes per measure.+quintuplets :: Music a b -> Music a b+quintuplets = tuplets 5++-- | Sixteenth rest+sr :: Music Dur a+sr = rest (1/16)++-- | Eighth rest+er :: Music Dur a+er = rest (1/8)++-- | Quarter rest+qr :: Music Dur a+qr = rest (1/4)++-- | Half rest+hr :: Music Dur a+hr = rest (1/2)++-- | Whole rest+wr :: Music Dur a+wr = rest 1
+ src/Bang/Interface/Drum.hs view
@@ -0,0 +1,314 @@+{-|+Module      : Bang.Interface.Drum+Description : An interface to the drum-specific operations in Bang.+Copyright   : (c) Benjamin Kovach, 2014+License     : MIT+Maintainer  : bkovach13@gmail.com+Stability   : experimental+Portability : Mac OSX++This module exports a number of functions that build primitive drum beats from various `PercussionSound`s. It also exports+some convenient shorthands for common drum types (i.e. snare, bass, toms, and cymbals). The more bizarre instruments have+slightly longer construction functions, but you'll find all of the sounds\' constructors here.+-}+module Bang.Interface.Drum where++import Bang.Music.Class+import Bang.Interface.Base+import System.MIDI++-- | An Enum representing the different types of things you can bang on.+data PercussionSound = +   BassDrum2+ | BassDrum1+ | SideStick+ | SnareDrum1+ | HandClap+ | SnareDrum2+ | LowTom2+ | ClosedHihat+ | LowTom1+ | PedalHihat+ | MidTom2+ | OpenHihat+ | MidTom1+ | HighTom2+ | CrashCymbal1+ | HighTom1+ | RideCymbal1+ | ChineseCymbal+ | RideBell+ | Tambourine+ | SplashCymbal+ | Cowbell+ | CrashCymbal2+ | VibraSlap+ | RideCymbal2+ | HighBongo+ | LowBongo+ | MuteHighConga+ | OpenHighConga+ | LowConga+ | HighTimbale+ | LowTimbale+ | HighAgogo+ | LowAgogo+ | Cabasa+ | Maracas+ | ShortWhistle+ | LongWhistle+ | ShortGuiro+ | LongGuiro+ | Claves+ | HighWoodBlock+ | LowWoodBlock+ | MuteCuica+ | OpenCuica+ | MuteTriangle+ | OpenTriangle+    deriving (Show,Eq,Ord,Enum)++-- | Convenience constructor for drum sounds+drum :: PercussionSound -> Dur -> Music Dur PercussionSound+drum ps d = Prim (Note d ps)++-- | Simple constructor for a quarter-note drum hit.+qd :: PercussionSound -> Music Dur PercussionSound+qd ps = drum ps (1/4)++-- | Get the MIDI offset number for a 'PercussionSound'+toMIDINum :: PercussionSound -> Int+toMIDINum ps = fromEnum ps + 35++-- | Closed Hi Hat+hc :: Music Dur PercussionSound+hc = closedHihat++-- | Open Hi Hat+ho :: Music Dur PercussionSound+ho = openHihat++-- | Pedal Hi Hat+hco :: Music Dur PercussionSound+hco = pedalHihat++-- | Bass Drum+bd :: Music Dur PercussionSound+bd = bassDrum1++-- | Bass Drum (alt)+bd2 :: Music Dur PercussionSound+bd2 = bassDrum2++-- | Snare+sn :: Music Dur PercussionSound+sn = snareDrum1++-- | Snare (alt)+sn2 :: Music Dur PercussionSound+sn2 = snareDrum2++-- | Snare Sidestick+stick :: Music Dur PercussionSound+stick = sideStick++-- | High Tom+t1 :: Music Dur PercussionSound+t1 = highTom1++-- | High Tom (alt)+t2 :: Music Dur PercussionSound+t2 = highTom2++-- | Mid Tom+t3 :: Music Dur PercussionSound+t3 = midTom1++-- | Mid Tom (alt)+t4 :: Music Dur PercussionSound+t4 = midTom2++-- | Low Tom+t5 :: Music Dur PercussionSound+t5 = lowTom1++-- | Low Tom (alt)+t6 :: Music Dur PercussionSound+t6 = lowTom2++-- | Crash Cymbal+cc :: Music Dur PercussionSound+cc  = crashCymbal1++-- | Crash Cymbal (alt)+cc2 :: Music Dur PercussionSound+cc2 = crashCymbal2++-- | Ride Cymbal+rc :: Music Dur PercussionSound+rc  = rideCymbal1++-- | Ride Cymbal (alt)+rc2 :: Music Dur PercussionSound+rc2 = rideCymbal2++-- | China Cymbal+china :: Music Dur PercussionSound+china  = chineseCymbal++-- | Splash Cymbal+splash :: Music Dur PercussionSound+splash = splashCymbal++-- | Bell+bell :: Music Dur PercussionSound+bell = rideBell++-- | Hand Clap+clap :: Music Dur PercussionSound+clap = handClap++-- | Convert a primitive 'PercussionSound' to a 'MidiEvent'+drumToMidiEvent :: Primitive Dur PercussionSound -> MidiEvent+drumToMidiEvent (Note d ps) = MidiEvent (fromIntegral (round d)) (MidiMessage 10 (NoteOn (fromEnum ps + 35) 64))++bassDrum2 :: Music Dur PercussionSound+bassDrum2 = qd BassDrum2++bassDrum1 :: Music Dur PercussionSound+bassDrum1 = qd BassDrum1++sideStick :: Music Dur PercussionSound+sideStick = qd SideStick++snareDrum1 :: Music Dur PercussionSound+snareDrum1 = qd SnareDrum1++handClap :: Music Dur PercussionSound+handClap = qd HandClap++snareDrum2 :: Music Dur PercussionSound+snareDrum2 = qd SnareDrum2++lowTom2 :: Music Dur PercussionSound+lowTom2 = qd LowTom2++closedHihat :: Music Dur PercussionSound+closedHihat = qd ClosedHihat++lowTom1 :: Music Dur PercussionSound+lowTom1 = qd LowTom1++pedalHihat :: Music Dur PercussionSound+pedalHihat = qd PedalHihat++midTom2 :: Music Dur PercussionSound+midTom2 = qd MidTom2++openHihat :: Music Dur PercussionSound+openHihat = qd OpenHihat++midTom1 :: Music Dur PercussionSound+midTom1 = qd MidTom1++highTom2 :: Music Dur PercussionSound+highTom2 = qd HighTom2++crashCymbal1 :: Music Dur PercussionSound+crashCymbal1 = qd CrashCymbal1++highTom1 :: Music Dur PercussionSound+highTom1 = qd HighTom1++rideCymbal1 :: Music Dur PercussionSound+rideCymbal1 = qd RideCymbal1++chineseCymbal :: Music Dur PercussionSound+chineseCymbal = qd ChineseCymbal++rideBell :: Music Dur PercussionSound+rideBell = qd RideBell++tambourine :: Music Dur PercussionSound+tambourine = qd Tambourine++splashCymbal :: Music Dur PercussionSound+splashCymbal = qd SplashCymbal++cowbell :: Music Dur PercussionSound+cowbell = qd Cowbell++crashCymbal2 :: Music Dur PercussionSound+crashCymbal2 = qd CrashCymbal2++vibraSlap :: Music Dur PercussionSound+vibraSlap = qd VibraSlap++rideCymbal2 :: Music Dur PercussionSound+rideCymbal2 = qd RideCymbal2++highBongo :: Music Dur PercussionSound+highBongo = qd HighBongo++lowBongo :: Music Dur PercussionSound+lowBongo = qd LowBongo++muteHighConga :: Music Dur PercussionSound+muteHighConga = qd MuteHighConga++openHighConga :: Music Dur PercussionSound+openHighConga = qd OpenHighConga++lowConga :: Music Dur PercussionSound+lowConga = qd LowConga++highTimbale :: Music Dur PercussionSound+highTimbale = qd HighTimbale++lowTimbale :: Music Dur PercussionSound+lowTimbale = qd LowTimbale++highAgogo :: Music Dur PercussionSound+highAgogo = qd HighAgogo++lowAgogo :: Music Dur PercussionSound+lowAgogo = qd LowAgogo++cabasa :: Music Dur PercussionSound+cabasa = qd Cabasa++maracas :: Music Dur PercussionSound+maracas = qd Maracas++shortWhistle :: Music Dur PercussionSound+shortWhistle = qd ShortWhistle++longWhistle :: Music Dur PercussionSound+longWhistle = qd LongWhistle++shortGuiro :: Music Dur PercussionSound+shortGuiro = qd ShortGuiro++longGuiro :: Music Dur PercussionSound+longGuiro = qd LongGuiro++claves :: Music Dur PercussionSound+claves = qd Claves++highWoodBlock :: Music Dur PercussionSound+highWoodBlock = qd HighWoodBlock++lowWoodBlock :: Music Dur PercussionSound+lowWoodBlock = qd LowWoodBlock++muteCuica :: Music Dur PercussionSound+muteCuica = qd MuteCuica++openCuica :: Music Dur PercussionSound+openCuica = qd OpenCuica++muteTriangle :: Music Dur PercussionSound+muteTriangle = qd MuteTriangle++openTriangle :: Music Dur PercussionSound+openTriangle = qd OpenTriangle
+ src/Bang/Interpreter.hs view
@@ -0,0 +1,31 @@+module Bang.Interpreter where++import Bang.Music.Class+import Bang.Interface.Drum++import System.MIDI+import Data.Bifunctor+import Data.Ratio+import Data.Monoid+++toList :: Music Dur PercussionSound -> [MidiEvent]+toList m = map drumToMidiEvent (interpret m)++merge :: Ord d => [Primitive d a] -> [Primitive d a] -> [Primitive d a]+merge [] ys = ys+merge xs [] = xs+merge (a:xs) (b:ys)+  | dur a <= dur b = a : merge xs (b:ys)+  | otherwise = b : merge (a:xs) ys++interpret :: Music Dur PercussionSound -> [Primitive Dur PercussionSound]+interpret = go 0+  where go d (a :+: b) = go d a `mappend` go (d + duration a) b+        go d (a :=: b) = go d a `merge`   go d b+        go d (Prim n@(Note _ _))       = [n{dur = d}]+        go d (Prim n@(Rest _))         = []+        go d (Modify (Tempo a) m)      = go d (first (*a) m)+        go d (Modify (BPM n)   m)      = go d (first (* (240000 % n)) m) -- breaks down when bpm has already been set+        go d (Modify (Instrument _) m) = go d m -- @TODO+
+ src/Bang/Music/Class.hs view
@@ -0,0 +1,132 @@+{-|+Module      : Bang.Music.Class+Description : Data declarations for Bang+Copyright   : (c) Benjamin Kovach, 2014+License     : MIT+Maintainer  : bkovach13@gmail.com+Stability   : experimental+Portability : Mac OSX++Implements the core data structures for use in the Bang library.+-}+{-# LANGUAGE NoMonomorphismRestriction #-}+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++-- |Primitive objects in music are simply notes with duration and type, or rests with only duration.+data Primitive d a = +    -- | A `Note` with duration `dur` and type `ntype`+    Note {dur :: d, ntype :: a}+    -- | A `Rest` with duration `dur`+  | 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++-- | A musical composition with duration type dur (typically `Dur`) and instrument type `a` (typically a `PercussionSound`)+data Music dur a = +    -- | A Primitive musical object.+    Prim (Primitive dur a)+    -- | Sequential composition of music+  | Music dur a :+: Music dur a+    -- | Parallel composition of music+  | Music dur a :=: Music dur a+    -- | Modifier (typically 'BPM' or 'Tempo' change)+  | Modify Control (Music dur a)+    deriving (Show, Eq)++-- | Simple data type representing different control structures for compositions.+data Control = +    BPM Integer               +    -- ^ Set the beats per minute (WARNING: Only set this once, or BPM will multiply!)+  | Tempo Rational            +    -- ^ Set the speed for a section of music (default 1)+  | Instrument InstrumentName +    -- ^ Change the instrument (currently unused)+    deriving (Show, Eq)++{-+  NB. `Music` under `:=:` also forms a monoid, so we'll give these similar names...+-}+instance Num dur => Monoid (Music dur a) where+  mappend = (:+:)+  mempty = Prim (Rest 0)++{-+  `fmap` (and `second`) maps over parameterized type (typically a Drum),+  and `first` maps over duration.+-}+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)++{-+  `foldMap` folds over parameterized type (typically a Drum),+  and `bifoldMap` folds over duration as well.+-}+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++-- | Simple data type representing the types of instruments Bang supports.+-- +-- Currently, the only value is 'DrumSet'.+data InstrumentName = DrumSet+  deriving (Show, Eq)++-- | Get the duration of a full composition+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++-- | Parallel 'mappend'+--+-- Part of a second 'Monoid' "instance" for 'Music'+cappend :: Music dur a -> Music dur a -> Music dur a+cappend = (:=:)++-- | Parallel 'mempty'+--+-- Part of a second 'Monoid' "instance" for 'Music'+cempty :: Num dur => Music dur a+cempty  = Prim (Rest 0)++-- | Parallel 'mconcat'+-- +-- Part of a second 'Monoid' "instance" for 'Music'+cconcat :: Num dur => [Music dur a] -> Music dur a+cconcat = foldr cappend cempty
+ src/Bang/Music/Operators.hs view
@@ -0,0 +1,160 @@+{-|+Module      : Bang.Music.Operators+Description : The DSL part of the Bang library+Copyright   : (c) Benjamin Kovach, 2014+License     : MIT+Maintainer  : bkovach13@gmail.com+Stability   : experimental+Portability : Mac OSX++Defines a number of operators to effectively piece together Bang compositions.+-}+module Bang.Music.Operators where++import Bang.Music.Class+import Bang.Music.Transform+import Bang.Interface.Base+import Data.Foldable(foldMap)++import Data.Monoid++-- |Infix operator for `cappend`+infixr 6 ><+(><) :: Music dur a -> Music dur a -> Music dur a+(><) = cappend++infixr 0 !>+-- |Set the `Tempo` of a composition (default 1)+-- +--  Example (play 4 bass drum hits at double speed):+--+-- > 2 !> (4 #> bd)+(!>) :: Rational -> Music a b -> Music a b+(!>) = tempo++infixr 1 #>+-- |Infix operator for 'repl'+--+-- Example (play a bass drum twice):+--+-- > 2 #> bd+(#>) :: Num a => Int -> Music a b -> Music a b+(#>) = repl++infixl 1 >>~+-- |Map a function over a list of compositions and sequentially compose them.+-- Note: This is just 'foldMap' specialized to the list Monoid.+--+-- Example (play 'sn', 't1' and 't2' all twice): +--+-- > (2 #>) >>~ [sn, t1, t2]+(>>~) :: Monoid b => (a -> b) -> [a] -> b+(>>~) = foldMap++-- |Infix operator for 'poly'+-- +-- Example (A 3\/4 polyrhythm):+--+-- > (3, 3 #> bd) ~=~ (4, 4 #> sn)+(~=~) :: (Dur, Music Dur b) -> (Dur, Music Dur b) -> Music Dur b+(~=~) = poly++infixl 2 ~=+-- |Infix operator for 'fitL'+--+-- Example (a 3\/4 polyrhythm with duration 3\/4):+-- +-- > (3 #> bd) ~= (4 #> sn)+(~=) :: Music Dur b -> Music Dur b -> Music Dur b+(~=) = fitL++infixr 2 =~+-- |Infix operator for 'fitR'+-- +-- Example (a 3\/4 polyrhythm with duration 1:+-- +-- > (3 #> bd) =~ (4 #> sn)+(=~) :: Music Dur b -> Music Dur b -> Music Dur b+(=~) = fitR++infixr 2 ~~+-- |Infix operator for 'withDuration'+--+-- Example:+--+-- @+-- 2 ~~ mconcat [+--    16 #> bd+--  , 4 #> sn+--  , wr+--  ]+-- @+(~~) :: Dur -> Music Dur b -> Music Dur b+(~~) = withDuration++infixr 2 <<~+-- |Infix operator for 'takeDur'+--+-- Example (Only play 2 bass drum hits):+-- +-- > (1/2) <<~ (4 #> bd)+(<<~) :: Dur -> Music Dur b -> Music Dur b+(<<~) = takeDur++infixr 2 ~>>+-- |Infix operator for 'dropDur'+--+-- Example (play 2 closed hi-hats):+-- +-- > (1/2) ~>> ( (2 #> bd) <> (2 #> hc) )+(~>>) :: Dur -> Music Dur b -> Music Dur b+(~>>) = dropDur++infixr 2 <@~+-- |Infix operator for 'hushFor'+--+-- Example (half rest, then two closed hi-hats):+--+-- > (1/2) ~@> ( (2 #> bd) <> (2 #> hc) )+(~@>) :: Dur -> Music Dur b -> Music Dur b+(~@>) = hushFor++infixr 2 ~@>+-- |Infix operator for 'hushFrom'+--+-- Example (two bass drum hits, then a half rest):+--+-- > (1/2) <@~ ( (2 #> bd) <> (2 #> hc) )+(<@~) :: Dur -> Music Dur b -> Music Dur b+(<@~) = hushFrom++infixr 0 <!>+-- |Infix operator for 'normalize'+-- +-- Example (Play 12 bass drum hits, then 4 closed hi-hats, then 3 snares, each within a single measure's time):+--+-- @+-- 1 \<!\> [+--     12 #> bd+--   , 4  #> hc+--   , 3  #> sn+--   ]+-- @+(<!>) :: Dur -> [Music Dur b] -> Music Dur b+(<!>) = normalize++infixr 0 >!<+-- |Infix operator for 'normalizeC'+-- +-- Example: (Play 12 bass drum hits, then 4 closed hi-hats, then 3 snares, +-- all concurrently within a single measure's time):+--+-- @+-- 1 >!< [+--     12 #> bd+--   , 4  #> hc+--   , 3  #> sn+--   ]+-- @+(>!<) :: Dur -> [Music Dur b] -> Music Dur b+(>!<) = normalizeC
+ src/Bang/Music/Transform.hs view
@@ -0,0 +1,126 @@+{-|+Module      : Bang.Music.Transform+Description : General transformations on compositions +Copyright   : (c) Benjamin Kovach, 2014+License     : MIT+Maintainer  : bkovach13@gmail.com+Stability   : experimental+Portability : Mac OSX++This module exports a number of functions to manipulate compositions in various ways.+-}+module Bang.Music.Transform where++import Bang.Music.Class+import Bang.Interface.Base+import Data.Monoid+import Data.Bifunctor+import Data.Foldable(foldMap)++-- |Reverses a composition+reverseMusic :: Music Dur b -> Music Dur b+reverseMusic p@(Prim _) = p+reverseMusic (a :+: b) = reverseMusic b :+: reverseMusic a+reverseMusic (a :=: b)+  | durA < durB = (rest diff :+: reverseMusic a) :=: reverseMusic b+  | durB < durA = reverseMusic a :=: (rest diff :+: reverseMusic b)+  | otherwise = reverseMusic a :=: reverseMusic b+  where (durA, durB) = (duration a, duration b)+        diff = abs $ durA - durB+reverseMusic m@(Modify c a) = Modify c (reverseMusic a)++-- |Play a composition forwards, then backwards.+mirror :: Music Dur b -> Music Dur b+mirror m = m <> reverseMusic m++-- |Play a composition backwards, then forwards.+mirrorR :: Music Dur b -> Music Dur b+mirrorR m = reverseMusic m <> m++-- |Play a composition forwards and backwards concurrently.+cross :: Music Dur b -> Music Dur b+cross m = m `cappend` reverseMusic m++-- |Take the first `d` duration units of a composition.+takeDur :: Dur -> Music Dur b -> Music Dur b+takeDur = go+  where go dr m | dr <= 0 = rest (abs dr)+                | otherwise = case m of+                    p@(Prim _)   -> p+                    (a :+: b)    -> go dr a :+: go (dr - duration a) b+                    (a :=: b)    -> go dr a :=: go dr b+                    (Modify c a) -> Modify c (go dr a)++-- |Drop the first `d` duration units of a composition.+dropDur :: Dur -> Music Dur b -> Music Dur b+dropDur = go+  where go dr m | dr <= 0 = m+                | otherwise = case m of+                    p@(Prim (Rest d'))   -> rest 0+                    p@(Prim (Note d' _)) -> rest 0+                    (a :+: b)    -> go dr a :+: go (dr - duration a) b+                    (a :=: b)    -> go dr a :=: go dr b+                    (Modify c a) -> Modify c (go dr a)   ++-- |Split a composition at a specific duration and return the composition+-- before said duration along with the rest of it. +partitionDur :: Dur -> Music Dur b -> (Music Dur b, Music Dur b)+partitionDur d m = (takeDur d m, dropDur d m)++-- |Turn the first `d` duration units of a composition into silence.+hushFor :: Dur -> Music Dur b -> Music Dur b+hushFor d m = rest d <> dropDur d m++-- |Turn the rest of a composition into silence after `d` duration units.+hushFrom :: Dur -> Music Dur b -> Music Dur b+hushFrom d m = takeDur d m <> rest (max (duration m - d) 0)++-- |Turn the section of a composition between `pos` and `d` into silence.+hushAt :: Dur -> Dur -> Music Dur b -> Music Dur b+hushAt pos d m = pre <> rest d <> dropDur d post+  where (pre, post) = partitionDur pos m++-- |Play a polyrhythm with 'm' having units of length 1\/x and 'n' with units of length 1\/y+-- +-- Example:+--+-- > poly (3, 3 #> bd) (4, 4 #> sn)+poly :: (Dur, Music Dur b) -> (Dur, Music Dur b) -> Music Dur b+poly (x, m) (y, n) = tempo (x/4) m :=: tempo (y/4) n++-- |Set the duration of a composition+withDuration :: Dur -> Music Dur b -> Music Dur b+withDuration d m = first (*(d/d')) m+  where d' = duration m++-- |Replicate a composition `n` times.+repl :: Num a => Int -> Music a b -> Music a b+repl n = mconcat . replicate n++-- |Infinitely repeat a composition.+rep :: Num a => Music a b -> Music a b+rep = mconcat . repeat++-- |Fit the duration of `b` to the duration of `a`+fitL :: Music Dur b -> Music Dur b -> Music Dur b+fitL a = cappend a . withDuration (duration a)++-- |Fit the duration of `a` into the duration of `b`+fitR :: Music Dur b -> Music Dur b -> Music Dur b+fitR = flip fitL++-- |Normalize the durations of each value in a list of Compositions to `d` and compose them sequentially.+normalize :: Dur -> [Music Dur b] -> Music Dur b+normalize d = foldMap (withDuration d)++-- |Normalize the durations of each value in a list of Compositions to `d` and compose them concurrently.+normalizeC :: Dur -> [Music Dur b] -> Music Dur b+normalizeC d = cconcat . map (withDuration d)++-- |Normalize each composition's duration to the duration of the first element in the list and compose sequentially.+normalize1 :: [Music Dur b] -> Music Dur b+normalize1 (x:xs)= foldMap (withDuration (duration x)) (x:xs)++-- |Normalize each composition's duration to the duration of the first element in the list and compose concurrently.+normalizeC1 :: [Music Dur b] -> Music Dur b+normalizeC1 (x:xs) = cconcat $ map (withDuration (duration x)) (x:xs)