Build fixes

bench/Memory/Tidal/Inputs.hs

@@ -3,7 +3,6 @@
 module Tidal.Inputs where
 
 import Sound.Tidal.Context hiding (Live)
-import Sound.Tidal.Signal.Compose ((#), (|*|))
 import Weigh
 
 columns :: Weigh ()

bench/Memory/Tidal/UIB.hs

@@ -16,4 +16,4 @@ euclidB =
     columns 
     func "euclid" (euclid (head ecA1) (head $ drop 1 ecA1)) ecA2
     func "euclidFull" (euclidFull (head ecA1) (head $ drop 1 ecA1) ecA2) ecA2
-    func "euclidBool" (_euclidBool 1) 100000
+    func "euclidBool" (_euclidBool 1 :: Int -> Signal Bool) 100000

bench/Speed/Main.hs

@@ -1,12 +1,12 @@
 module Main where
 
-import Criterion.Main 
-import Tidal.PatternB
-import Tidal.CoreB
-import Tidal.UIB
+import           Criterion.Main (defaultMain)
+import           Tidal.CoreB
+import           Tidal.PatternB
+import           Tidal.UIB
 
-patternBs :: [IO ()] 
-patternBs = defaultMain <$> [withQueryTimeB, withQueryArcB, withResultArcB, withQueryTimeB, subArcB]
+patternBs :: [IO ()]
+patternBs = defaultMain <$> [[sectB], [hullB]]
 
 coreBs :: [IO ()] 
 coreBs = defaultMain <$> [fromListB, stackB, appendB, concatB, _fastB]
@@ -16,7 +16,6 @@ uiBs = defaultMain <$> [euclidB, fixB]
 
 main :: IO ()
 main = do 
-  _ <- sequence coreBs 
-  _ <- sequence patternBs
-  _ <- sequence uiBs
-  return ()
+  sequence_ coreBs
+  sequence_ patternBs
+  sequence_ uiBs

bench/Speed/Tidal/CoreB.hs

@@ -9,7 +9,7 @@ _fastB :: [Benchmark]
 _fastB = 
   [ bgroup "_fast" [
       bench "_fast < 0" $ whnf (_fast (-2)) pattApp2 
-    , bench "_fast > 0" $ whnf (_fast (toTime $ 10^6)) (cat catPattBig) ]
+    , bench "_fast > 0" $ whnf (_fast (10^6)) (cat catPattBig) ]
   ]
 
 concatB :: [Benchmark] 
@@ -23,16 +23,21 @@ concatB =
   , bench "timeCat 10^6" $ whnf timeCat timeCatBig ]
   ]
 
+signalFromList :: [Time] -> Signal Time
+signalFromList = fromList
+signalFastFromList :: [Time] -> Signal Time
+signalFastFromList = fastFromList
+
 fromListB :: [Benchmark]
 fromListB = 
   [ bgroup "fromList" [
-     bench "fromList" $ whnf fromList xs6 
-   , bench "fromList nf" $ nf fromList xs6
-   , bench "fastFromList 10^3" $ whnf fastFromList xs3 
-   , bench "fastFromList 10^4" $ whnf fastFromList xs4 
-   , bench "fastFromList 10^5" $ whnf fastFromList xs5 
-   , bench "fastFromList 10^6" $ whnf fastFromList xs6
-   , bench "fastFromList 10^6 nf" $ nf fastFromList xs6 ]
+     bench "fromList" $ whnf signalFromList xs6
+   , bench "fromList nf" $ nf signalFromList xs6
+   , bench "fastFromList 10^3" $ whnf signalFastFromList xs3
+   , bench "fastFromList 10^4" $ whnf signalFastFromList xs4
+   , bench "fastFromList 10^5" $ whnf signalFastFromList xs5
+   , bench "fastFromList 10^6" $ whnf signalFastFromList xs6
+   , bench "fastFromList 10^6 nf" $ nf signalFastFromList xs6 ]
   ]
 
 appendB :: [Benchmark] 

bench/Speed/Tidal/PatternB.hs

@@ -1,44 +1,15 @@
 module Tidal.PatternB where 
 
-import Criterion.Main
-import Tidal.Inputs
-import Sound.Tidal.Pattern
+import           Criterion.Main    (Benchmark, bench, whnf)
+import           Sound.Tidal.Arc   (hull, sect)
+import           Sound.Tidal.Types (ArcF (Arc))
 
-arc1 = Arc 3 5 
+arc1 = Arc 3 5
 arc2 = Arc 4 6
 arc3 = Arc 0 1
 arc4 = Arc 1 2
 
-withQueryTimeB :: [Benchmark] 
-withQueryTimeB = 
-  [ bgroup "withQueryTime" [
-      bench "wqt whnf" $ whnf withQueryTime (*2) 
-    , bench "wqt2 whnf" $ whnf withQueryTime (+1)
-    , bench "wqt nf" $ nf withQueryTime (*2) ]
-  ]
-
-withResultArcB :: [Benchmark]
-withResultArcB = 
-  [ bgroup "withResultArc" [
-      bench "wqa med" $ whnf (withResultArc arcFunc) wqaMed
-    , bench "wqa big" $ whnf (withResultArc arcFunc) wqaBig ]
-  ]
-
-withQueryArcB :: [Benchmark]
-withQueryArcB = 
-  [ bgroup "withQueryArc" [
-      bench "wqa med" $ whnf (withQueryArc arcFunc) wqaMed
-    , bench "wqa big" $ whnf (withQueryArc arcFunc) wqaBig ]
-  ]
-
-subArcB :: [Benchmark]
-subArcB = 
-  [ bgroup "subArc" [ 
-      bench "intersecting" $ whnf (subArc arc1) arc2
-    , bench "non-intersecting" $ whnf (subArc arc3) arc4 ]
-  ]
-
-sectB :: Benchmark 
+sectB :: Benchmark
 sectB = bench "sect" $ whnf (sect arc1) arc2
 
 hullB :: Benchmark 

bench/Speed/Tidal/UIB.hs

@@ -18,5 +18,5 @@ euclidB =
   [ bgroup "euclid" [
       bench "euclid" $ whnf (euclid (head ecA1) (head $ drop 1 ecA1)) ecA2 
     , bench "euclidFull" $ whnf (euclidFull (head ecA1) (head $ drop 1 ecA1) ecA2) ecA2
-   , bench "euclidBool" $ whnf (_euclidBool 1) 100000]
+   , bench "euclidBool" $ whnf (_euclidBool 1 :: Int -> Signal Bool) 100000]
   ]

stack.yaml

@@ -2,7 +2,6 @@ resolver: lts-20.5
 
 packages:
   - '.'
-  - 'tidal-parse'
   - 'tidal-link'
 
 extra-deps:

test/Sound/Tidal/SequenceTest.hs

@@ -2,52 +2,61 @@
 
 module Sound.Tidal.SequenceTest where
 
-import           Test.Microspec
-import           TestUtils
+import           Test.Microspec          (MTestable (describe), Microspec,
+                                          Property, it, shouldBe)
+import           TestUtils               (stripSequenceMetadata)
 
 import           Prelude                 hiding ((*>), (<*))
 
-import           Sound.Tidal.Pattern
 import           Sound.Tidal.Sequence
 import           Sound.Tidal.Signal.Base (queryArc)
-import           Sound.Tidal.Types
+import           Sound.Tidal.Types       (ArcF (Arc), Direction (In, Out),
+                                          Event (Event), Metadata (Metadata),
+                                          Sequence (Atom, Cat), Signal,
+                                          Strategy (Centre, Expand), Time)
+
+shouldMatch :: (Eq a, Show a) => Sequence a -> Sequence a -> Property
+shouldMatch seq1 seq2 = shouldBe (stripSequenceMetadata seq1) (stripSequenceMetadata seq2)
+
+tAtom :: Time -> Time -> Time -> Maybe a -> Sequence a
+tAtom = Atom mempty
 
 run :: Microspec ()
 run =
   describe "Sound.Tidal.Sequence" $ do
     describe "pairAligned" $ do
       it "Aligns pairs of events" $ do
         (pairAligned In ("10 20", "1 2") :: Sequence (Int, Int))
-          `shouldBe`
+          `shouldMatch`
           Cat [step 1 (10,1), step 1 (20,2)]
     describe "pairAlign" $ do
       it "Can centre two sequences, paired into structure of the first one." $ do
         (pairAlign Centre In "10" "1 2")
-          `shouldBe`
-          (Cat [Atom 0.5 0 0 Nothing,
-                Atom 0.5 0 0.5 $ Just (10,1),
-                Atom 0.5 0.5 0 $ Just (10,2),
-                Atom 0.5 0 0 Nothing
+          `shouldMatch`
+          (Cat [tAtom 0.5 0 0 Nothing,
+                tAtom 0.5 0 0.5 $ Just (10,1),
+                tAtom 0.5 0.5 0 $ Just (10,2),
+                tAtom 0.5 0 0 Nothing
                ] :: Sequence (Int,Int))
     describe "alignF" $ do
       it "Can align and combine two sequences by Expansion and addition" $ do
         ((alignF Expand In (+) "0 1 2" "10 20") :: Sequence Int)
-          `shouldBe`
-          (Cat [Atom 1 0 0 $ Just 10, Atom 0.5 0 0.5 $ Just 11, Atom 0.5 0.5 0 $ Just 21,
-                Atom 1 0 0 $ Just 22])
+          `shouldMatch`
+          (Cat [tAtom 1 0 0 $ Just 10, tAtom 0.5 0 0.5 $ Just 11, tAtom 0.5 0.5 0 $ Just 21,
+                tAtom 1 0 0 $ Just 22])
       it "Can align and combine subsequences by Expansion and addition" $ do
         ((alignF Expand In (+) "0 [1 2] 3" "10 20") :: Sequence Int)
-          `shouldBe`
-          (Cat [Atom 1 0 0 $ Just 10, Atom 0.5 0 0 $ Just 11, Atom 0.5 0 0 $ Just 22,
-                Atom 1 0 0 $ Just 23])
+          `shouldMatch`
+          (Cat [tAtom 1 0 0 $ Just 10, tAtom 0.5 0 0 $ Just 11, tAtom 0.5 0 0 $ Just 22,
+                tAtom 1 0 0 $ Just 23])
       it "Can align and combine subsequences by Expansion and addition" $ do
         ((alignF Expand In (+) "0 [1 2] 3" "10 [20 30]") :: Sequence Int)
-          `shouldBe`
-          (Cat [Atom 1 0 0 $ Just 10, Atom 0.5 0 0 $ Just 11, Atom 0.5 0 0 $ Just 22,
-                Atom 0.25 0 0.75 $ Just 23, Atom 0.75 0.25 0 $ Just 33])
+          `shouldMatch`
+          (Cat [tAtom 1 0 0 $ Just 10, tAtom 0.5 0 0 $ Just 11, tAtom 0.5 0 0 $ Just 22,
+                tAtom 0.25 0 0.75 $ Just 23, tAtom 0.75 0.25 0 $ Just 33])
     describe "beatMode" $ do
       it "Can turn a sequence into a signal" $ do
-        (queryArc ((seqToSignal' ( alignF Centre Out (+) ("10 20 30") ("1 2")) :: Signal Int)) (Arc 0 1))
+        (queryArc ((seqToSignal' (stripSequenceMetadata $ alignF Centre Out (+) ("10 20 30") ("1 2")) :: Signal Int)) (Arc 0 1))
           `shouldBe`
           [Event (Metadata []) (Just $ Arc (1/6) (1/2)) (Arc (1/6) (1/3)) 11,
            Event (Metadata []) (Just $ Arc (1/6) (1/2)) (Arc (1/3) (1/2)) 21,

test/Sound/Tidal/SignalBaseTest.hs

@@ -2,27 +2,33 @@
 
 module Sound.Tidal.SignalBaseTest where
 
-import           Test.Microspec
-import           TestUtils
+import           Test.Microspec              (MTestable (describe), Microspec,
+                                              Testable (property), it, shouldBe,
+                                              (===))
+import           TestUtils                   (compareP, comparePD,
+                                              stripMetadata, toEvent)
 
 import           Prelude                     hiding ((*>), (<*))
 
 import           Data.List                   (sort)
-import           Data.Ratio
+import           Data.Ratio                  ((%))
 
 import           Sound.Tidal.Compose         (struct, (|+), (|=|))
 import           Sound.Tidal.Params          (n, s)
 import           Sound.Tidal.ParseBP         (parseBP_E)
-import           Sound.Tidal.Pattern         (_slow, append, atom, cat, euclid,
-                                              every, fast, fastCat,
-                                              filterValues, ply, press, pressBy,
-                                              range, rev, run, silence, slow,
-                                              stack, superimpose, timeCat, (*>),
-                                              (<*))
+import           Sound.Tidal.Pattern         (Pattern (atom, filterValues, rev, silence, stack, timeCat, (*>), (<*)),
+                                              _slow, append, cat, early, euclid,
+                                              euclidFull, euclidInv, every,
+                                              fast, fastCat, late, ply, press,
+                                              pressBy, range, run, slow,
+                                              superimpose, (<~))
 import           Sound.Tidal.Signal.Base
 import           Sound.Tidal.Signal.Random   (irand)
 import           Sound.Tidal.Signal.Waveform (saw, sine, tri)
-import           Sound.Tidal.Types
+import           Sound.Tidal.Types           (ArcF (Arc), Event (Event),
+                                              Metadata (Metadata), Note,
+                                              Signal (query), State (State),
+                                              Time, Value (VF))
 
 import qualified Data.Map.Strict             as Map
 

test/TestUtils.hs

@@ -61,3 +61,8 @@ stripMetadata = setMetadata $ Metadata []
 
 toEvent :: (((Time, Time), (Time, Time)), a) -> Event a
 toEvent (((ws, we), (ps, pe)), v) = Event (Metadata []) (Just $ Arc ws we) (Arc ps pe) v
+
+stripSequenceMetadata :: Sequence a -> Sequence a
+stripSequenceMetadata = withAtom f
+  where f (Atom _ d i o v) = Atom mempty d i o v
+        f x                = x