seq

minipat/src/Minipat/Interp.hs

@@ -19,7 +19,6 @@ import Bowtie (Anno (..))
 import Control.Exception (Exception)
 import Control.Monad.Except (Except, runExcept)
 import Control.Monad.Trans (lift)
-import Data.Foldable1 (foldl1')
 import Data.Ratio ((%))
 import Data.Sequence (Seq (..))
 import Data.Sequence.NonEmpty (NESeq)
@@ -55,6 +54,7 @@ import Minipat.Stream
   , streamRand
   , streamReplicate
   , streamSlow
+  , streamPar
   )
 import Minipat.Time (CycleDelta (..))
 
@@ -124,15 +124,15 @@ lookInterp (InterpEnv sel proj) = \case
   PatGroup (Group _ ty els) -> do
     els' <- lift (sequenceA els)
     case ty of
-      GroupTypeSeq _ -> pure (streamConcat els', 1)
-      GroupTypePar -> pure (foldl1' (<>) (fmap fst els'), 1)
+      GroupTypeSeq _ -> pure (streamConcat (NESeq.toSeq els'), 1)
+      GroupTypePar -> pure (streamPar (fmap fst (NESeq.toSeq els')), 1)
       GroupTypeRand ->
         let els'' = fmap (\(el, w) -> streamFastBy (unCycleDelta w) el) els'
-            s = streamRand els''
+            s = streamRand (NESeq.toSeq els'')
         in  pure (s, 1)
       GroupTypeAlt ->
         let els'' = fmap (\(el, w) -> streamFastBy (unCycleDelta w) el) els'
-            s = streamAlt els''
+            s = streamAlt (NESeq.toSeq els'')
         in  pure (s, 1)
   PatMod (Mod melw md) ->
     case md of

minipat/src/Minipat/Stream.hs

@@ -40,6 +40,7 @@ module Minipat.Stream
   , streamEuclid
   , streamRand
   , streamAlt
+  , streamPar
   )
 where
 
@@ -49,8 +50,8 @@ import Data.Heap (Entry (..), Heap)
 import Data.Heap qualified as H
 import Data.Maybe (fromMaybe)
 import Data.Semigroup (Semigroup (..))
-import Data.Sequence.NonEmpty (NESeq)
-import Data.Sequence.NonEmpty qualified as NESeq
+import Data.Sequence (Seq)
+import Data.Sequence qualified as Seq
 import Data.String (IsString (..))
 import Minipat.Rand (arcSeed, randFrac, randInt, spanSeed)
 import Minipat.Time
@@ -218,16 +219,20 @@ streamDegradeBy r (Stream k) = Stream (tapeDegradeBy r . k)
 streamDegrade :: Stream Rational -> Stream a -> Stream a
 streamDegrade = streamAdjust streamDegradeBy
 
-streamConcat :: NESeq (Stream a, CycleDelta) -> Stream a
-streamConcat ss = Stream $ \arc ->
-  -- Sketch: split arc into cycles, for each render each stream over the cycle, slowing
-  -- by length, then speed everything up by whole amount to fit all into one cycle
-  let w = sum (fmap snd ss)
-      go1 (i, Span subArc _) = tapeFastBy i (unCycleDelta w) (snd (go2 i subArc))
-      go2 i subArc = foldl' (go3 i subArc) (0, mempty) ss
-      go3 i subArc (!o, !t) (p, v) =
-        (o + v, t <> tapeLateBy o (tapeSlowBy i (unCycleDelta v) (unStream p subArc)))
-  in  mconcat (fmap go1 (spanSplit arc))
+streamConcat :: Seq (Stream a, CycleDelta) -> Stream a
+streamConcat ss =
+  if Seq.null ss
+    then mempty
+    else
+      Stream $ \arc ->
+      -- Sketch: split arc into cycles, for each render each stream over the cycle, slowing
+      -- by length, then speed everything up by whole amount to fit all into one cycle
+      let w = sum (fmap snd ss)
+          go1 (i, Span subArc _) = tapeFastBy i (unCycleDelta w) (snd (go2 i subArc))
+          go2 i subArc = foldl' (go3 i subArc) (0, mempty) ss
+          go3 i subArc (!o, !t) (p, v) =
+            (o + v, t <> tapeLateBy o (tapeSlowBy i (unCycleDelta v) (unStream p subArc)))
+      in  mconcat (fmap go1 (spanSplit arc))
 
 streamReplicate :: Int -> Stream a -> Stream a
 streamReplicate n s = Stream $ \arc ->
@@ -247,31 +252,40 @@ streamEuclid filled steps (fromMaybe 0 -> shift) s =
   let activeEl = (s, 1)
       passiveEl = (mempty, 1)
       eucSeq =
-        NESeq.fromFunction steps $ \ix0 ->
+        Seq.fromFunction steps $ \ix0 ->
           let ix1 = ix0 + shift
               ix = if ix1 >= steps then ix1 - steps else ix1
               active = mod ix filled == 0
           in  if active then activeEl else passiveEl
   in  streamConcat eucSeq
 
-streamRand :: NESeq (Stream a) -> Stream a
+streamRand :: Seq (Stream a) -> Stream a
 streamRand ss =
-  let l = NESeq.length ss
-      f arc =
-        let s = arcSeed arc
-            i = randInt l s
-            t = NESeq.index ss i
-        in  unStream t arc
-  in  Stream (foldMap' (f . spanActive . snd) . spanSplit)
-
-streamAlt :: NESeq (Stream a) -> Stream a
+  if Seq.null ss
+    then mempty
+    else
+      let l = Seq.length ss
+          f arc =
+            let s = arcSeed arc
+                i = randInt l s
+                t = Seq.index ss i
+            in  unStream t arc
+      in  Stream (foldMap' (f . spanActive . snd) . spanSplit)
+
+streamAlt :: Seq (Stream a) -> Stream a
 streamAlt ss =
-  let l = NESeq.length ss
-      f z arc =
-        let i = mod (fromInteger (unCycle z)) l
-            t = NESeq.index ss i
-        in  unStream t arc
-  in  Stream (foldMap' (\(z, sp) -> f z (spanActive sp)) . spanSplit)
+  if Seq.null ss
+    then mempty
+    else
+      let l = Seq.length ss
+          f z arc =
+            let i = mod (fromInteger (unCycle z)) l
+                t = Seq.index ss i
+            in  unStream t arc
+      in  Stream (foldMap' (\(z, sp) -> f z (spanActive sp)) . spanSplit)
+
+streamPar :: Seq (Stream a) -> Stream a
+streamPar = foldl' (<>) mempty
 
 -- TODO move to module with continuous primitives
 -- fnSine :: Rational -> Time -> Double