diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,26 @@ + +Copyright (c) 2013, Hans Höglund +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of the nor the + names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#! /usr/bin/env runhaskell + +> import Distribution.Simple +> main = defaultMain diff --git a/music-pitch-literal.cabal b/music-pitch-literal.cabal new file mode 100644 --- /dev/null +++ b/music-pitch-literal.cabal @@ -0,0 +1,25 @@ + +name: music-pitch-literal +version: 1.1 +cabal-version: >= 1.2 +author: Hans Hoglund +maintainer: Hans Hoglund +license: BSD3 +license-file: COPYING +synopsis: Overloaded pitch literals. +category: Music +tested-with: GHC +build-type: Simple + +description: + This package allow you to write the pitches of standard notation as expressions + overloaded on result type. This works exactly like numeric literals (and string + literals when using the @OverloadedStrings@ extension). + +library + build-depends: + base >= 4 && < 5 + hs-source-dirs: src + exposed-modules: + Music.Pitch.Literal + diff --git a/src/Music/Pitch/Literal.hs b/src/Music/Pitch/Literal.hs new file mode 100644 --- /dev/null +++ b/src/Music/Pitch/Literal.hs @@ -0,0 +1,130 @@ + +------------------------------------------------------------------------------------- +-- | +-- Copyright : (c) Hans Hoglund 2012 +-- +-- License : BSD-style +-- +-- Maintainer : hans@hanshoglund.se +-- Stability : experimental +-- Portability : portable +-- +-- Provides overloaded pitch literals. +-- +------------------------------------------------------------------------------------- + +module Music.Pitch.Literal ( + + PitchL(..), + Pitched(..), + + cs' , ds' , es' , fs' , gs' , as' , bs' , + c' , d' , e' , f' , g' , a' , b' , + cb' , db' , eb' , fb' , gb' , ab' , bb' , + + cs , ds , es , fs , gs , as , bs , + c , d , e , f , g , a , b , + cb , db , eb , fb , gb , ab , bb , + + cs_ , ds_ , es_ , fs_ , gs_ , as_ , bs_ , + c_ , d_ , e_ , f_ , g_ , a_ , b_ , + cb_ , db_ , eb_ , fb_ , gb_ , ab_ , bb_ + + ) where + +newtype PitchL = PitchL { getPitchL :: (Int, Maybe Double, Int) } + +-- Like Num can be expressed using arabic numerals, instances +-- of Pitched can be expressed using Western pitch names (c, c sharp, c flat etc) +class Pitched a where + fromPitch :: PitchL -> a + +instance Pitched PitchL where + fromPitch = id + + +cs' , ds' , es' , fs' , gs' , as' , bs' :: Pitched a => a +c' , d' , e' , f' , g' , a' , b' :: Pitched a => a +cb' , db' , eb' , fb' , gb' , ab' , bb' :: Pitched a => a + +cs , ds , es , fs , gs , as , bs :: Pitched a => a +c , d , e , f , g , a , b :: Pitched a => a +cb , db , eb , fb , gb , ab , bb :: Pitched a => a + +cs_ , ds_ , es_ , fs_ , gs_ , as_ , bs_ :: Pitched a => a +c_ , d_ , e_ , f_ , g_ , a_ , b_ :: Pitched a => a +cb_ , db_ , eb_ , fb_ , gb_ , ab_ , bb_ :: Pitched a => a + + +cs' = fromPitch $ PitchL (0, Just 1, 5) +ds' = fromPitch $ PitchL (1, Just 1, 5) +es' = fromPitch $ PitchL (2, Just 1, 5) +fs' = fromPitch $ PitchL (3, Just 1, 5) +gs' = fromPitch $ PitchL (4, Just 1, 5) +as' = fromPitch $ PitchL (5, Just 1, 5) +bs' = fromPitch $ PitchL (6, Just 1, 5) + +c' = fromPitch $ PitchL (0, Nothing, 5) +d' = fromPitch $ PitchL (1, Nothing, 5) +e' = fromPitch $ PitchL (2, Nothing, 5) +f' = fromPitch $ PitchL (3, Nothing, 5) +g' = fromPitch $ PitchL (4, Nothing, 5) +a' = fromPitch $ PitchL (5, Nothing, 5) +b' = fromPitch $ PitchL (6, Nothing, 5) + +cb' = fromPitch $ PitchL (0, Just (-1), 5) +db' = fromPitch $ PitchL (1, Just (-1), 5) +eb' = fromPitch $ PitchL (2, Just (-1), 5) +fb' = fromPitch $ PitchL (3, Just (-1), 5) +gb' = fromPitch $ PitchL (4, Just (-1), 5) +ab' = fromPitch $ PitchL (5, Just (-1), 5) +bb' = fromPitch $ PitchL (6, Just (-1), 5) + +cs = fromPitch $ PitchL (0, Just 1, 4) +ds = fromPitch $ PitchL (1, Just 1, 4) +es = fromPitch $ PitchL (2, Just 1, 4) +fs = fromPitch $ PitchL (3, Just 1, 4) +gs = fromPitch $ PitchL (4, Just 1, 4) +as = fromPitch $ PitchL (5, Just 1, 4) +bs = fromPitch $ PitchL (6, Just 1, 4) + +c = fromPitch $ PitchL (0, Nothing, 4) +d = fromPitch $ PitchL (1, Nothing, 4) +e = fromPitch $ PitchL (2, Nothing, 4) +f = fromPitch $ PitchL (3, Nothing, 4) +g = fromPitch $ PitchL (4, Nothing, 4) +a = fromPitch $ PitchL (5, Nothing, 4) +b = fromPitch $ PitchL (6, Nothing, 4) + +cb = fromPitch $ PitchL (0, Just (-1), 4) +db = fromPitch $ PitchL (1, Just (-1), 4) +eb = fromPitch $ PitchL (2, Just (-1), 4) +fb = fromPitch $ PitchL (3, Just (-1), 4) +gb = fromPitch $ PitchL (4, Just (-1), 4) +ab = fromPitch $ PitchL (5, Just (-1), 4) +bb = fromPitch $ PitchL (6, Just (-1), 4) + +cs_ = fromPitch $ PitchL (0, Just 1, 3) +ds_ = fromPitch $ PitchL (1, Just 1, 3) +es_ = fromPitch $ PitchL (2, Just 1, 3) +fs_ = fromPitch $ PitchL (3, Just 1, 3) +gs_ = fromPitch $ PitchL (4, Just 1, 3) +as_ = fromPitch $ PitchL (5, Just 1, 3) +bs_ = fromPitch $ PitchL (6, Just 1, 3) + +c_ = fromPitch $ PitchL (0, Nothing, 3) +d_ = fromPitch $ PitchL (1, Nothing, 3) +e_ = fromPitch $ PitchL (2, Nothing, 3) +f_ = fromPitch $ PitchL (3, Nothing, 3) +g_ = fromPitch $ PitchL (4, Nothing, 3) +a_ = fromPitch $ PitchL (5, Nothing, 3) +b_ = fromPitch $ PitchL (6, Nothing, 3) + +cb_ = fromPitch $ PitchL (0, Just (-1), 3) +db_ = fromPitch $ PitchL (1, Just (-1), 3) +eb_ = fromPitch $ PitchL (2, Just (-1), 3) +fb_ = fromPitch $ PitchL (3, Just (-1), 3) +gb_ = fromPitch $ PitchL (4, Just (-1), 3) +ab_ = fromPitch $ PitchL (5, Just (-1), 3) +bb_ = fromPitch $ PitchL (6, Just (-1), 3) +