{-# LANGUAGE OverloadedStrings #-}
module Sound.Tidal.CoreTest where
import Data.List (sort)
import Data.Ratio
import qualified Data.Map as Map
import Sound.Tidal.Context
import Test.Microspec
import TestUtils
import Prelude hiding ((*>), (<*))
run :: Microspec ()
run =
describe "Sound.Tidal.Core" $ do
describe "Elemental patterns" $ do
let sampleOf :: Pattern Double -> Rational -> Double
sampleOf pat t = (value . head) $ query pat (State (Arc t t) Map.empty)
describe "are in range [0, 1]" $ do
let inNormalRange pat t = (y >= 0) && (y <= 1)
where y = sampleOf pat t
it "sine" $ inNormalRange sine
it "cosine" $ inNormalRange cosine
it "saw" $ inNormalRange saw
it "isaw" $ inNormalRange isaw
it "tri" $ inNormalRange tri
it "square" $ inNormalRange square
describe "have correctly-scaled bipolar variants" $ do
let areCorrectlyScaled pat pat2 t = (y * 2 - 1) ~== y2
where y = sampleOf pat t
y2 = sampleOf pat2 t
it "sine" $ areCorrectlyScaled sine sine2
it "cosine" $ areCorrectlyScaled cosine cosine2
it "saw" $ areCorrectlyScaled saw saw2
it "isaw" $ areCorrectlyScaled isaw isaw2
it "tri" $ areCorrectlyScaled tri tri2
it "square" $ areCorrectlyScaled square square2
describe "append" $
it "can switch between the cycles from two pures" $ do
queryArc (append (pure "a") (pure "b")) (Arc 0 5)
`shouldBe` fmap
toEvent
[ (((0, 1), (0, 1)), "a" :: String),
(((1, 2), (1, 2)), "b"),
(((2, 3), (2, 3)), "a"),
(((3, 4), (3, 4)), "b"),
(((4, 5), (4, 5)), "a")
]
describe "cat" $ do
it "can switch between the cycles from three pures" $ do
queryArc (cat [pure "a", pure "b", pure "c"]) (Arc 0 5)
`shouldBe` fmap
toEvent
[ (((0, 1), (0, 1)), "a" :: String),
(((1, 2), (1, 2)), "b"),
(((2, 3), (2, 3)), "c"),
(((3, 4), (3, 4)), "a"),
(((4, 5), (4, 5)), "b")
]
it "can extract nested revs" $
let a = "1 2 3" :: Pattern Int
b = "4 5 6" :: Pattern Int
c = "7 8 9" :: Pattern Int
in comparePD
(Arc 0 10)
(rev $ cat [a, b, c])
(cat [rev a, rev b, rev c])
describe "fastCat" $ do
it "can switch between the cycles from three pures inside one cycle" $ do
it "1" $
queryArc (fastCat [pure "a", pure "b", pure "c"]) (Arc 0 1)
`shouldBe` fmap
toEvent
[ (((0, 1 / 3), (0, 1 / 3)), "a" :: String),
(((1 / 3, 2 / 3), (1 / 3, 2 / 3)), "b"),
(((2 / 3, 1), (2 / 3, 1)), "c")
]
it "5/3" $
queryArc (fastCat [pure "a", pure "b", pure "c"]) (Arc 0 (5 / 3))
`shouldBe` fmap
toEvent
[ (((0, 1 / 3), (0, 1 / 3)), "a" :: String),
(((1 / 3, 2 / 3), (1 / 3, 2 / 3)), "b"),
(((2 / 3, 1), (2 / 3, 1)), "c"),
(((1, 4 / 3), (1, 4 / 3)), "a"),
(((4 / 3, 5 / 3), (4 / 3, 5 / 3)), "b")
]
it "works with zero-length queries" $ do
it "0" $
queryArc (fastCat [pure "a", pure "b"]) (Arc 0 0)
`shouldBe` fmap toEvent [(((0, 0.5), (0, 0)), "a" :: String)]
it "1/3" $
queryArc (fastCat [pure "a", pure "b"]) (Arc (1 % 3) (1 % 3))
`shouldBe` fmap toEvent [(((0, 0.5), (1 % 3, 1 % 3)), "a" :: String)]
describe "rev" $ do
it "mirrors events" $ do
let forward = fastCat [fastCat [pure 7, pure 8], pure 9] :: Pattern Int
backward = fastCat [pure 9, fastCat [pure 8, pure 7]]
-- sort the events into time order to compare them
sort (queryArc (rev forward) (Arc 0 1)) `shouldBe` sort (queryArc backward (Arc 0 1))
it "returns the original if you reverse it twice" $ do
let x = fastCat [fastCat [pure 7, pure 8], pure 9] :: Pattern Int
queryArc (rev $ rev x) (Arc 0 5) `shouldBe` queryArc x (Arc 0 5)
describe "|>|" $ do
let a = "[1, 1] [2,2] 3" :: Pattern Int
b = "4 [5, 5] 6 7" :: Pattern Int
c = "7 8 9 10" :: Pattern Int
d = "7 [8, 9] 10 11" :: Pattern Int
it "creates silence when" $ do
it "first argument silent" $
comparePD
(Arc 0 1)
(silence |>| a)
silence
it "second argument silent" $
comparePD
(Arc 0 1)
(a |>| silence)
silence
it "creates the same pattern when left argument has the same structure" $
comparePD
(Arc 0 1)
(b |>| a)
(d |>| a)
it "can extract rev from first argument" $
comparePD
(Arc 0 1)
(rev a |>| b)
(rev (a |>| rev b))
it "is assiociative" $
comparePD
(Arc 0 1)
((a |>| b) |>| c)
(a |>| (b |>| c))
it "is commutative in all arguments except the rightmost" $
comparePD
(Arc 0 1)
(a |>| b |>| c)
(b |>| a |>| c)
describe "stack" $ do
let a = "1 2 3" :: Pattern Int
b = "4 5 6" :: Pattern Int
c = "7 8 9" :: Pattern Int
it "is neutral with silence" $
comparePD
(Arc 0 1)
(stack [a, silence])
a
it "can create silence" $
comparePD
(Arc 0 1)
(stack [] :: Pattern Int)
silence
it "follows commutative laws" $
comparePD
(Arc 0 1)
(stack [a, b])
(stack [b, a])
it "follows assiociative laws" $
comparePD
(Arc 0 1)
(stack [a, stack [b, c]])
(stack [stack [a, b], c])
it "can extract nested revs" $
comparePD
(Arc 0 1)
(rev $ stack [a, b, c])
(stack [rev a, rev b, rev c])
describe "fast" $ do
let x = "1 2 3" :: Pattern Time
y = "4 5 6" :: Pattern Time
it "is neutral with speedup 1" $
comparePD
(Arc 0 1)
(fast 1 x)
x
it "mutes, when there is" $ do
it "silence in first argument" $
comparePD
(Arc 0 1)
(fast silence x)
silence
it "silence in second argument" $
comparePD
(Arc 0 1)
(fast x silence :: Pattern Time)
silence
it "speedup by 0" $
comparePD
(Arc 0 1)
(fast 0 x)
silence
it "is reciprocal to slow" $
comparePD
(Arc 0 1)
(fast 2 x)
(slow (fromRational $ 1 % 2) x)
it "can be reversed by reciprocal speedup" $
comparePD
(Arc 0 1)
(fast 2 $ fast (fromRational $ 1 % 2) x)
x
it "preserves structure" $
comparePD
(Arc 0 1)
(fast x (stack [y, y]))
(fast (stack [x, x]) y)
describe "slow" $ do
let x = "1 2 3" :: Pattern Time
y = "4 5 6" :: Pattern Time
it "is neutral with slowdown 1" $
comparePD
(Arc 0 10)
(slow 1 x)
x
it "mutes, when there is" $ do
it "silence in first argument" $
comparePD
(Arc 0 10)
(slow silence x)
silence
it "silence in second argument" $
comparePD
(Arc 0 10)
(slow x silence :: Pattern Time)
silence
it "speedup by 0" $
comparePD
(Arc 0 10)
(slow 0 x)
silence
it "is reciprocal to fast" $
comparePD
(Arc 0 10)
(slow 2 x)
(fast (fromRational $ 1 % 2) x)
it "can be reversed by reciprocal slowdown" $
comparePD
(Arc 0 10)
(slow 2 $ slow (fromRational $ 1 % 2) x)
x
it "preserves structure" $
comparePD
(Arc 0 1)
(slow x (stack [y, y]))
(slow (stack [x, x]) y)
describe "compress" $ do
it "squashes cycles to the start of a cycle" $ do
let p = compress (0, 0.5) $ fastCat [pure 7, pure 8] :: Pattern Int
queryArc p (Arc 0 1)
`shouldBe` fmap
toEvent
[ (((0, 0.25), (0, 0.25)), 7),
(((0.25, 0.5), (0.25, 0.5)), 8)
]
it "squashes cycles to the end of a cycle" $ do
let p = compress (0.5, 1) $ fastCat [pure 7, pure 8] :: Pattern Int
queryArc p (Arc 0 1)
`shouldBe` fmap
toEvent
[ (((0.5, 0.75), (0.5, 0.75)), 7 :: Int),
(((0.75, 1), (0.75, 1)), 8)
]
it "squashes cycles to the middle of a cycle" $ do
let p = compress (0.25, 0.75) $ fastCat [pure 7, pure 8]
queryArc p (Arc 0 1)
`shouldBe` fmap
toEvent
[ (((0.25, 0.5), (0.25, 0.5)), 7 :: Int),
(((0.5, 0.75), (0.5, 0.75)), 8)
]
describe "saw" $ do
it "goes from 0 up to 1 every cycle" $ do
it "0" $
queryArc saw (Arc 0 0) `shouldBe` [Event (Context []) Nothing (Arc 0 0) 0 :: Event Double]
it "0.25" $
queryArc saw (Arc 0.25 0.25) `shouldBe` [Event (Context []) Nothing (Arc 0.25 0.25) 0.25 :: Event Double]
it "0.5" $
queryArc saw (Arc 0.5 0.5) `shouldBe` [Event (Context []) Nothing (Arc 0.5 0.5) 0.5 :: Event Double]
it "0.75" $
queryArc saw (Arc 0.75 0.75) `shouldBe` [Event (Context []) Nothing (Arc 0.75 0.75) 0.75 :: Event Double]
it "can be added to" $
map value (queryArc ((+ 1) <$> saw) (Arc 0.5 0.5)) `shouldBe` [1.5 :: Float]
it "works on the left of <*>" $
queryArc ((+) <$> saw <*> pure 3) (Arc 0 1)
`shouldBe` [Event (Context []) Nothing (Arc 0 1) 3.5 :: Event Double]
it "works on the right of <*>" $
queryArc (fast 4 (pure (+ 3)) <*> saw) (Arc 0 1)
`shouldBe` [ Event (Context []) Nothing (Arc 0 0.25) 3.5 :: Event Double,
Event (Context []) Nothing (Arc 0.25 0.5) 3.5,
Event (Context []) Nothing (Arc 0.5 0.75) 3.5,
Event (Context []) Nothing (Arc 0.75 1) 3.5
]
it "can be reversed" $ do
it "works with whole cycles" $
queryArc (rev saw) (Arc 0 1)
`shouldBe` [Event (Context []) Nothing (Arc 0 1) 0.5 :: Event Double]
it "works with half cycles" $
queryArc (rev saw) (Arc 0 0.5)
`shouldBe` [Event (Context []) Nothing (Arc 0 0.5) 0.75 :: Event Double]
it "works with inset points" $
queryArc (rev saw) (Arc 0.25 0.25)
`shouldBe` [Event (Context []) Nothing (Arc 0.25 0.25) 0.75 :: Event Double]
describe "tri" $ do
it "goes from 0 up to 1 and back every cycle" $
comparePD
(Arc 0 1)
(struct "t*8" (tri :: Pattern Double))
"0.125 0.375 0.625 0.875 0.875 0.625 0.375 0.125"
it "can be added to" $
comparePD
(Arc 0 1)
(struct "t*8" $ (tri :: Pattern Double) + 1)
"1.125 1.375 1.625 1.875 1.875 1.625 1.375 1.125"
describe "every" $
it "`every n id` doesn't change the pattern's structure" $ do
comparePD
(Arc 0 4)
(every 2 id "x/2" :: Pattern String)
"x/2"