fadno 1.1.6 → 1.1.7
raw patch · 7 files changed
+267/−12 lines, 7 filesdep −comonaddep −deepseqdep −fadno-braidsdep ~base
Dependencies removed: comonad, deepseq, fadno-braids, split
Dependency ranges changed: base
Files
- fadno.cabal +7/−6
- src/Fadno/Xml.hs +15/−6
- tests/MeterSpec.hs +124/−0
- tests/NotationSpec.hs +22/−0
- tests/NoteSpec.hs +33/−0
- tests/UtilSpec.hs +44/−0
- tests/XmlSpec.hs +22/−0
fadno.cabal view
@@ -1,7 +1,7 @@ name: fadno category: Music synopsis: Minimal library for music generation and notation-version: 1.1.6+version: 1.1.7 homepage: http://github.com/slpopejoy/fadno description: Provides the Note type and HasNote class with polymorphic pitch and duration representations, metering, barring and time signature utilities, plus midi and MusicXML support.@@ -29,20 +29,16 @@ -- other-extensions: build-depends: Decimal >= 0.4 , HUnit >= 1.5- , base >= 4.9 && < 4.14+ , base >= 4.9 && < 4.15 , containers >= 0.5- , comonad >= 5 , data-default >= 0.7- , deepseq >= 1.4 , event-list >= 0.1- , fadno-braids >= 0.1.5 , fadno-xml >= 1.2 , lens >= 4.15 , midi >= 0.2 , mtl >= 2.2 , process >= 1.4 , safe >= 0.3- , split >= 0.2 , text >= 1.2 , unordered-containers >= 0.2 , vector >= 0.12@@ -55,6 +51,11 @@ main-is: Tests.hs hs-source-dirs: tests default-language: Haskell2010+ other-modules: MeterSpec+ , NotationSpec+ , NoteSpec+ , UtilSpec+ , XmlSpec build-depends: base , containers
src/Fadno/Xml.hs view
@@ -166,12 +166,21 @@ -- | Measure barlines. xmlBarline :: (ApplyMonoid c ChxMusicData) => N.HasBarline a => a -> c ChxMusicData-xmlBarline = maybeMusicData N.barline $ \b ->- case b of- N.Double -> mdBarline RightLeftMiddleLeft- BarStyleLightLight Nothing- N.Final -> mdBarline RightLeftMiddleRight- BarStyleLightHeavy Nothing+xmlBarline = xmlBarline' False+++-- | Measure barlines; flag determines if double bars are rendered to left (False)+-- or right (True).+xmlBarline' :: (ApplyMonoid c ChxMusicData) => Bool -> N.HasBarline a => a -> c ChxMusicData+xmlBarline' renderDoubleLeft = maybeMusicData N.barline $ \b ->+ case b of+ N.Double -> mdBarline doublePos+ BarStyleLightLight Nothing+ N.Final -> mdBarline RightLeftMiddleRight+ BarStyleLightHeavy Nothing+ where+ doublePos | renderDoubleLeft = RightLeftMiddleLeft+ | otherwise = RightLeftMiddleRight -- | Measure repeats for a single measure. xmlRepeats :: (ApplyMonoid t ChxMusicData) => N.HasRepeats a => a -> t ChxMusicData
+ tests/MeterSpec.hs view
@@ -0,0 +1,124 @@++module MeterSpec where++import Test.HUnit+import Fadno.Meter+import Data.Ratio+import Fadno.Note+import Fadno.Notation+import Control.Lens+import GHC.Real++_i :: Int -> Int+_i = id+_n = map (map (_i 1|:))+++tests :: Test+tests = "meter" ~: [+ "rebar" ~: [+ rebars' (TimeSignature 4 Q4)+ [[[_i 1]|:2%8,rest $ 3%8,[1,2]|:11%8] ,+ [[4,5]|:4%8,rest $ 5%8],+ [[3]|:3%8]]+ @?=+ [bar [note' ([1]|:2%8),rest (3%8),note' ([1,2]|:3%8) & tie ?~ TStart]+ & timeSignature ?~ 4/:Q4 ,+ bar [note' ([1,2]|:8%8) & tie ?~ TStop] ,+ bar [note' ([4,5]|:4%8), rest (4%8)] ,+ bar [rest (1%8),note' ([3]|:3%8)] & timeSignature ?~ 2/:Q4],+ rebars' (TimeSignature 4 Q4)+ [[[_i 1]|:2%8,rest $ 3%8,[1,2]|:11%8],+ [[4,5]|:4%8,rest $ 5%8],+ [[3]|:1%8]]+ @?=+ [bar [note' ([1]|:2%8),rest $ 3%8,note' ([1,2]|:3%8) & tie ?~ TStart]+ & timeSignature ?~ 4/:Q4,+ bar [note' ([1,2]|:8%8) & tie ?~ TStop],+ bar [note' ([4,5]|:4%8), note' ([]|:1 % 2),note' ([]|:1 % 8),note' ([3]|:1 % 8)]+ & timeSignature ?~ 5/:Q4],+ rebar' (TimeSignature 5 Q4)+ [([_i 40]|:2%8),([41]|:2%8),([42]|:1%8),+ ([41]|:5%8),([42]|:3%8),([41]|:2%8)]+ @?=+ [bar [note' ([40]|:2%8),note' ([41]|:2%8),note' ([42]|:1%8),+ note' ([41]|:5%8)] & timeSignature ?~ (5/:Q4),+ bar [note' ([42]|:3%8),note' ([41]|:2%8)] & timeSignature ?~ (5/:Q8)],+ rebar (TimeSignature 5 Q4)+ [([_i 40]|:2%8),([41]|:2%8),([42]|:1%8),+ ([41]|:5%8),([42]|:3%8)] @?=+ [bar [note' ([40]|:2%8),note' ([41]|:2%8),note' ([42]|:1%8),note' ([41]|:5%8),+ note' ([42]|:3%8)] & timeSignature ?~ (13/:Q8)],+ rebar' (2/:Q4) [[_i 1]|:4%1] @?=+ [bar [note' ([1]|:1 % 2) & tie ?~ TStart] & timeSignature ?~ 2/:Q4,+ bar [note' ([1]|:1 % 2) & tie ?~ TBoth],+ bar [note' ([1]|:1 % 2) & tie ?~ TBoth],+ bar [note' ([1]|:1 % 2) & tie ?~ TBoth],+ bar [note' ([1]|:1 % 2) & tie ?~ TBoth],+ bar [note' ([1]|:1 % 2) & tie ?~ TBoth],+ bar [note' ([1]|:1 % 2) & tie ?~ TBoth],+ bar [note' ([1]|:1 % 2) & tie ?~ TStop]],+ -- Bad TS bug+ rebar (4/:Q4) [M 72|:11 % 8] @?=+ [bar [note' (M 72|:1 % 1) & tie ?~ TStart,note' (M 72|:3 % 8) & tie ?~ TStop] & timeSignature ?~ 11/:Q8],+ -- bad joinLast bug+ rebar (4/:Q4) [M 72|:9 % 8,M 72|:1%4] @?=+ [bar [note' (M 72|:1 % 1) & tie ?~ TStart,note' (M 72|:1 % 8) & tie ?~ TStop,+ note' (M 72|:1 % 4)] & timeSignature ?~ 11/:Q8]+++ ],+ "validDur" ~: [+ filter ((==False).snd) (map (\d -> (d,validDur d))+ [2,+ 1,3%2,7%4,+ 1%2,3%4,7%8,+ 1%8,3%16,+ 1%5,2%5,3%5,7%5,+ 1%3,2%3,4%3]) @?= [],+ filter ((==True).snd) (map (\d -> (d,validDur d))+ [3,7%2,15%4,15%8,+ 5%4,9%8,15%16,+ 15%5,5%3,15%7]) @?= []+ ],+ "splitDur" ~: [+ splitDur (17%20) @?= [3 % 5,1 % 4],+ splitDur (5:%10) @?= [1 % 5,3 % 10],+ splitDur 4 @?= [2,2],+ splitDur (5%8) @?= [1 % 4,3 % 8]+ ],+ "tieRules" ~: [+ -- test normal split+ tieRules' [mono' (_i 1) $ 5%8,rest $ 5%8] @?=+ bar [mono 1 (1%4) & tie ?~ TStart,+ mono 1 (3%8) & tie ?~ TStop,+ rest (1%4),+ rest (3%8)],+ -- test split with pre-existing tie (both)+ tieRules' [note' ([_i 1]|:5%8) & tie ?~ TBoth] @?=+ bar [note' ([1]|:1%4) & tie ?~ TBoth,+ note' ([1]|:3%8) & tie ?~ TBoth],+ -- test split with pre-existing tie (start)+ tieRules' [note' ([_i 1]|:5%8) & tie ?~ TStart] @?=+ bar [note' ([1]|:1%4) & tie ?~ TStart,+ note' ([1]|:3%8) & tie ?~ TBoth],+ -- test split with pre-existing tie (end)+ tieRules' [note' ([_i 1]|:5%8) & tie ?~ TStop] @?=+ bar [note' ([1]|:1%4) & tie ?~ TBoth,+ note' ([1]|:3%8) & tie ?~ TStop],+ -- test no split, with pre-existing tie+ tieRules' [note' ([_i 1]|:1) & tie ?~ TBoth] @?= bar [note' ([_i 1]|:1) & tie ?~ TBoth],+ -- test split, one note+ tieRules' [[_i 1]|:11%8] @?=+ bar [note' ([1]|:2:%4) & tie ?~ TStart,+ note' ([1]|:7%8) & tie ?~ TStop]+ ],+ "selectTimeSig" ~: [+ selectTimeSig (_n [[3%4,2%4,3%8,2%8],[3%4,2%4]])+ @?= Just (5/:Q4),+ selectTimeSig (_n [[1%4,1%4,1%4,1%4],[2%4,2%4,1%4,1%4,2%4]])+ @?= Just (4/:Q4),+ selectTimeSig (_n [[3%8,3%8,3%8,3%8],[1%8,1%4,3%8,3%4],[3%8,3%8]])+ @?= Just (6/:Q8)+ ]+ ]
+ tests/NotationSpec.hs view
@@ -0,0 +1,22 @@++module NotationSpec where++import Test.HUnit+import Fadno.Notation+import Data.Ratio++tests = "notation" ~: [+ "qFromInt" ~: [+ map qFromInt [0::Int,1,2,3,4,5,8,16,32,64] @?=+ [Nothing,Nothing,Just Q2,Nothing,Just Q4,Nothing,+ Just Q8,Just Q16,Just Q32,Just Q64],+ map qToInt [Q2,Q4,Q8,Q16,Q32,Q64] @?=+ [2,4,8,16,32,64]+ ],+ "tsFromRatio" ~: [+ tsFromRatio (1%4) @?= Just (2/:Q8) -- "1" nums become 2+ ,tsFromRatio (2%1) @?= Just (8/:Q4) -- "1" denoms become 4+ ,tsFromRatio (3%8) @?= Just (3/:Q8)+ ,tsFromRatio (3%5) @?= Nothing+ ]+ ]
+ tests/NoteSpec.hs view
@@ -0,0 +1,33 @@++module NoteSpec where++import Test.HUnit+import Fadno.Note+++_m :: Note (Mono Int) Int -> Note (Mono Int) Int; _m = id+_i :: Note Int Int -> Note Int Int; _i = id+_c :: Note [Int] Int -> Note [Int] Int; _c = id+tests :: Test+tests = "domain" ~: [+ "tied" ~: [+ tied [_i$2|:1,2|:2] @?= [2|:3],+ tied [_c$[2,3]|:1,[2,3]|:2] @?= [[2,3]|:3],+ tied ([_m$M 2|:1,rest 1]) @?= [M 2|:1,rest 1],+ --tied ([[3]|:2,[3,2]|:3,[3,2]|:2,[3]|:5,[3]|:3]) @?=+ -- [[3]|:2,[3,2]|:5,[3]:8],+ tied ([_i$2|:1]) @?= [2|:1],+ tied ([_m(rest 1),rest 2,M 2|:4]) @?= [rest 3,M 2|:4]+ ],+ "legato" ~: [+ legato [_m$M 2|:2,rest 2,M 3|:4] @?= [M 2|:4,M 3|:4],+ legato [_c(rest 2),[3,4]|:4,rest 5,[6]|:7] @?= [rest 2,[3,4]|:9,[6]|:7]+ ],+ "sumDurs" ~: [+ sumDurs [_c$[1]|:1,rest 2] @?= 3,+ sumDurs ([] :: [Note Int Int]) @?= 0+ ],+ "mapTime" ~: [+ mapTime [_i$1|:2,3|:4,5|:6] @?= [(0,1|:2),(2,3|:4),(6,5|:6)]+ ]+ ]
+ tests/UtilSpec.hs view
@@ -0,0 +1,44 @@++module UtilSpec where++import Test.HUnit+import Fadno.Util+import qualified Data.Map as M++++tests = "util" ~: [+ "diff" ~: test [+ diff [5,10,8,2,3] @?= [5,-2,-6,1]+ ],+ "normalize" ~: test [+ normalize [1,3,2] @?= [0,2,1]+ ],+ "pitchClassSet" ~: test [+ pitchClassSet 12 [1,2,3,5,9,13,16] @?= [0,1,2,3,4,8],+ pitchClassSet 12 [4,6,2,11] @?= [0,3,5,7],+ pitchClassSet 12 [19,9,10,5,8,0] @?= [0,2,3,4,5,7]+ ], "monotonic" ~: test [+ monotonic [1,2,4] @?= True,+ monotonic [4,4,5,9] @?= True,+ monotonic [4,4,3] @?= True,+ monotonic [-1,-3,-5] @?= True,+ monotonic [1,2,1] @?= False,+ monotonic [2,1,1,3] @?= False+ ], "interleave" ~: test [+ interleave [[1,2,3,4],[5,6,7],[8,9,0]] @?= [1,5,8,2,6,9,3,7,0]+ ], "pivot" ~: test [+ pivot [[1,2,3,4],[5,6,7],[8,9,0]] @?= [[1,5,8],[2,6,9],[3,7,0]]+ ], "lfsr" ~: test [+ take 30 (lfsr 4 2 3) @?=+ take 30 (cycle [False,False,False,True,False,False,True,True,+ False,True,False,True,True,True,True])+ ], "filterOnKeys" ~: test [+ filterOnKeys [1,5] (M.fromList [(1,2),(3,4),(5,6),(7,8)]) @?=+ M.fromList [(1,2),(5,6)]+ ], "pairBy" ~: test [+ pairBy (+2) [1,2,3] @?= [(1,3),(2,4),(3,5)]+ ], "delim" ~: test [+ delim "," ["1","2","3","4"] @?= "1,2,3,4"+ ]+ ]
+ tests/XmlSpec.hs view
@@ -0,0 +1,22 @@++module XmlSpec where++import Test.HUnit+import Fadno.Meter+import Data.Ratio+import Fadno.Note+import Fadno.Notation+import Control.Lens+import GHC.Real+import Fadno.Xml+import Fadno.MusicXml.MusicXml31++tests :: Test+tests = "xml" ~: [+ "convertDurR" ~:+ [ convertDurR xmlDivisions (1 % 4) @?= (xmlDivisions,NoteTypeValueQuarter,0)+ , convertDurR xmlDivisions (1 % 2) @?= (xmlDivisions*2,NoteTypeValueHalf,0)+ , convertDurR xmlDivisions (2 :% 4) @?= (xmlDivisions*2,NoteTypeValueHalf,0)+ , convertDurR xmlDivisions (3 % 4) @?= (xmlDivisions*3,NoteTypeValueHalf,1)+ ]+ ]