diff --git a/app/Main.hs b/app/Main.hs deleted file mode 100644 --- a/app/Main.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Main where - -import Lib - -main :: IO () -main = someFunc diff --git a/mezzo.cabal b/mezzo.cabal --- a/mezzo.cabal +++ b/mezzo.cabal @@ -1,5 +1,5 @@ name: mezzo -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Typesafe music composition description: A Haskell music composition library that enforces common musical rules in the type system. @@ -16,8 +16,7 @@ library hs-source-dirs: src - exposed-modules: Lib - , Mezzo + exposed-modules: Mezzo , Mezzo.Model , Mezzo.Model.Prim , Mezzo.Model.Music @@ -27,6 +26,7 @@ , Mezzo.Model.Harmony.Functional , Mezzo.Model.Reify + , Mezzo.Compose , Mezzo.Compose.Types , Mezzo.Compose.Builder , Mezzo.Compose.Templates @@ -34,6 +34,7 @@ , Mezzo.Compose.Harmonic , Mezzo.Compose.Combine + , Mezzo.Render , Mezzo.Render.MIDI build-depends: base >= 4.7 && < 5 @@ -41,14 +42,6 @@ , template-haskell , HCodecs , boxes - default-language: Haskell2010 - -executable mezzo-exe - hs-source-dirs: app - main-is: Main.hs - ghc-options: -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , mezzo default-language: Haskell2010 test-suite mezzo-test diff --git a/src/Lib.hs b/src/Lib.hs deleted file mode 100644 --- a/src/Lib.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Lib - ( someFunc - ) where - -someFunc :: IO () -someFunc = putStrLn "someFunc" diff --git a/src/Mezzo.hs b/src/Mezzo.hs --- a/src/Mezzo.hs +++ b/src/Mezzo.hs @@ -1,6 +1,27 @@ -module Mezzo - ( someFunc - ) where -someFunc :: IO () -someFunc = putStrLn "someFunc" +----------------------------------------------------------------------------- +-- | +-- Module : Mezzo +-- Description : Mezzo core module +-- Copyright : (c) Dima Szamozvancev +-- License : MIT +-- +-- Maintainer : ds709@cam.ac.uk +-- Stability : experimental +-- Portability : portable +-- +-- Module providing the external interface to the Mezzo library and EDSL. +-- +----------------------------------------------------------------------------- + +module Mezzo (module X) where + +-- Uses import/export shortcut as suggested by HLint. + +import Mezzo.Render as X +import Mezzo.Compose as X +import Mezzo.Model as X + ( Music (..) + , Voice (..) + , Partiture (..) + ) diff --git a/src/Mezzo/Compose.hs b/src/Mezzo/Compose.hs new file mode 100644 --- /dev/null +++ b/src/Mezzo/Compose.hs @@ -0,0 +1,25 @@ + +----------------------------------------------------------------------------- +-- | +-- Module : Mezzo.Compose +-- Description : Mezzo music description language +-- Copyright : (c) Dima Szamozvancev +-- License : MIT +-- +-- Maintainer : ds709@cam.ac.uk +-- Stability : experimental +-- Portability : portable +-- +-- Module providing the external interface to the Mezzo EDSL. +-- +----------------------------------------------------------------------------- + +module Mezzo.Compose (module X) where + +-- Uses import/export shortcut as suggested by HLint. + +import Mezzo.Compose.Basic as X +import Mezzo.Compose.Builder as X +import Mezzo.Compose.Types as X +import Mezzo.Compose.Combine as X +import Mezzo.Compose.Harmonic as X diff --git a/src/Mezzo/Compose/Basic.hs b/src/Mezzo/Compose/Basic.hs --- a/src/Mezzo/Compose/Basic.hs +++ b/src/Mezzo/Compose/Basic.hs @@ -38,9 +38,9 @@ octaveLits -- ** Duration literals and terminators +mk32ndLits join <$> traverse mkDurLits [''Whole, ''Half, ''Quarter, ''Eighth, ''Sixteenth] -mk32ndLits -- * Pitches diff --git a/src/Mezzo/Compose/Combine.hs b/src/Mezzo/Compose/Combine.hs --- a/src/Mezzo/Compose/Combine.hs +++ b/src/Mezzo/Compose/Combine.hs @@ -24,9 +24,14 @@ , durToInt , duration , voices + , restWhile , pad + , pad2 + , pad3 + , pad4 -- * Melody composition , play + , melody ) where import Mezzo.Model @@ -68,9 +73,38 @@ chordVoices :: forall (n :: Nat) (c :: ChordType n) . Primitive n => Cho c -> Int chordVoices _ = prim (undefined :: ChordType n) -- Need to get a kind-level variable to the term level --- | Add an empty voice to the end of a piece of music. -pad :: (HarmConstraints m (FromSilence b), Primitive b) => Music (m :: Partiture (a - 1) b) -> Music ((m +-+ FromSilence b) :: Partiture a b) -pad m = m :-: rest (musicDur m) +-- | Add an empty voice to the piece of music. +pad :: (HarmConstraints m (FromSilence b), Primitive b) + => Music (m :: Partiture (a - 1) b) -> Music ((m +-+ FromSilence b) :: Partiture a b) +pad m = m :-: restWhile m + +-- | Add two empty voices to the piece of music. +pad2 :: ( HarmConstraints m (FromSilence b) + , HarmConstraints (m +-+ FromSilence b) (FromSilence b) + , Primitive b) + => Music (m :: Partiture (a - 2) b) -> Music ((m +-+ FromSilence b +-+ FromSilence b) :: Partiture a b) +pad2 m = m :-: restWhile m :-: restWhile m + +-- | Add three empty voices to the piece of music. +pad3 :: ( HarmConstraints m (FromSilence b) + , HarmConstraints (m +-+ FromSilence b) (FromSilence b) + , HarmConstraints (m +-+ FromSilence b +-+ FromSilence b) (FromSilence b) + , Primitive b) + => Music (m :: Partiture (a - 3) b) -> Music ((m +-+ FromSilence b +-+ FromSilence b +-+ FromSilence b) :: Partiture a b) +pad3 m = m :-: restWhile m :-: restWhile m :-: restWhile m + +-- | Add four empty voices to the piece of music. +pad4 :: ( HarmConstraints m (FromSilence b) + , HarmConstraints (m +-+ FromSilence b) (FromSilence b) + , HarmConstraints (m +-+ FromSilence b +-+ FromSilence b) (FromSilence b) + , HarmConstraints (m +-+ FromSilence b +-+ FromSilence b +-+ FromSilence b) (FromSilence b) + , Primitive b) + => Music (m :: Partiture (a - 4) b) -> Music ((m +-+ FromSilence b +-+ FromSilence b +-+ FromSilence b +-+ FromSilence b) :: Partiture a b) +pad4 m = m :-: restWhile m :-: restWhile m :-: restWhile m :-: restWhile m + +-- | Rest for the duration of the given music piece. +restWhile :: Primitive l => Music (m :: Partiture n l) -> Music (FromSilence l) +restWhile m = rest (musicDur m) ------------------------------------------------------------------------------- -- Melodies diff --git a/src/Mezzo/Compose/Templates.hs b/src/Mezzo/Compose/Templates.hs --- a/src/Mezzo/Compose/Templates.hs +++ b/src/Mezzo/Compose/Templates.hs @@ -125,26 +125,26 @@ dec1' <- [d| $(varP litName') = Dur |] return $ tySig1 : dec1 ++ tySig1' : dec1' noteTerm <- do - let valName = mkName $ head (durLitFormatter name) : "n" + let valName = mkName $ (durLitFormatter name) !! 1 : "n" tySig2 <- sigD valName $ [t| forall r. IntRep r => RootT r $(conT name) |] dec2 <- [d| $(varP valName) = \p -> Note p $(varE litName) |] - let valName' = mkName $ head (durLitFormatter name) : "n\'" + let valName' = mkName $ (durLitFormatter name) !! 1 : "n\'" tySig2' <- sigD valName' $ [t| forall r. IntRep r => RootT r (Dot $(conT name)) |] dec2' <- [d| $(varP valName') = \p -> Note p $(varE litName') |] return $ tySig2 : dec2 ++ tySig2' : dec2' restTerm <- do - let valName = mkName $ head (durLitFormatter name) : "r" + let valName = mkName $ (durLitFormatter name) !! 1 : "r" tySig2 <- sigD valName $ [t| RestT $(conT name) |] dec2 <- [d| $(varP valName) = const (Rest $(varE litName)) |] - let valName' = mkName $ head (durLitFormatter name) : "r\'" + let valName' = mkName $ (durLitFormatter name) !! 1 : "r\'" tySig2' <- sigD valName' $ [t| RestT (Dot $(conT name)) |] dec2' <- [d| $(varP valName') = const (Rest $(varE litName')) |] return $ tySig2 : dec2 ++ tySig2' : dec2' chordTerm <- do - let valName = mkName $ head (durLitFormatter name) : "c" + let valName = mkName $ (durLitFormatter name) !! 1 : "c" tySig2 <- sigD valName $ [t| forall n r. (Primitive n, IntListRep r) => ChorT (r :: ChordType n) $(conT name) |] dec2 <- [d| $(varP valName) = \c -> Chord c $(varE litName) |] - let valName' = mkName $ head (durLitFormatter name) : "c\'" + let valName' = mkName $ (durLitFormatter name) !! 1 : "c\'" tySig2' <- sigD valName' $ [t| forall n r. (Primitive n, IntListRep r) => ChorT (r :: ChordType n) (Dot $(conT name)) |] dec2' <- [d| $(varP valName') = \c -> Chord c $(varE litName') |] return $ tySig2 : dec2 ++ tySig2' : dec2' @@ -152,7 +152,7 @@ mk32ndLits :: DecsQ -- Don't want to make dotted literals for thirty second notes. mk32ndLits = do - let litName = mkName $ "th" + let litName = mkName $ "_th" literal <- do tySig1 <- sigD litName $ [t| Dur $(conT ''ThirtySecond) |] dec1 <- [d| $(varP litName) = Dur |] @@ -260,16 +260,16 @@ -- | 'Accidental' formatter. accFormatter :: Formatter -accFormatter = map toLower . take 2 . nameBase +accFormatter = ('_' :) . map toLower . take 2 . nameBase -- | 'OctaveNum' formatter. octFormatter :: Formatter -octFormatter oct = 'o' : drop 3 (nameBase oct) +octFormatter oct = "_o" ++ drop 3 (nameBase oct) -- | One letter accidental with explicit 'Naturals'. shortAccFormatter :: Formatter -shortAccFormatter (accFormatter -> "fl") = "f" -shortAccFormatter (accFormatter -> name) = [head name] +shortAccFormatter (accFormatter -> "_fl") = "f" +shortAccFormatter (accFormatter -> name) = [name !! 1] -- | One letter accidental with implicit 'Naturals'. shorterAccFormatter :: Formatter @@ -292,7 +292,7 @@ -- | Formatter for duration literals. durLitFormatter :: Formatter -durLitFormatter = map toLower . take 2 . nameBase +durLitFormatter = ('_' :) . map toLower . take 2 . nameBase -- | Formatter for pitch literals. pitchLitFormatter :: Name -> Name -> Name -> String @@ -314,7 +314,7 @@ "AugTriad" -> "_aug" "DimTriad" -> "_dim" "MajSeventh" -> "_maj7" - "MajMinSeventh" -> "_sev" + "MajMinSeventh" -> "_dom7" "MinSeventh" -> "_min7" "HalfDimSeventh" -> "_hdim7" "DimSeventh" -> "_dim7" diff --git a/src/Mezzo/Render.hs b/src/Mezzo/Render.hs new file mode 100644 --- /dev/null +++ b/src/Mezzo/Render.hs @@ -0,0 +1,21 @@ + +----------------------------------------------------------------------------- +-- | +-- Module : Mezzo.Render +-- Description : Mezzo exporting module +-- Copyright : (c) Dima Szamozvancev +-- License : MIT +-- +-- Maintainer : ds709@cam.ac.uk +-- Stability : experimental +-- Portability : portable +-- +-- Module providing the external interface to the Mezzo exporting module. +-- +----------------------------------------------------------------------------- + +module Mezzo.Render (module X) where + +-- Uses import/export shortcut as suggested by HLint. + +import Mezzo.Render.MIDI as X