estream

minipat-dirt/src/Minipat/Dirt/Boot.hs

@@ -75,7 +75,7 @@ stop = setPlaying False
 handshake :: (Dirt) => IO ()
 handshake = C.handshake dirt
 
-peek :: (Dirt, Show a) => Stream a -> IO ()
+peek :: (Dirt, Show a) => EStream a -> IO ()
 peek = C.peek dirt
 
 d0, d1, d2, d3, d4, d5, d6, d7 :: (Dirt) => EStream Attrs -> IO ()

minipat-dirt/src/Minipat/Dirt/Core.hs

@@ -242,13 +242,16 @@ handshake st = bracket acq rel (const (pure ()))
       else logError (stLogger st) "... handshake FAILED"
     setPlaying st ok
 
-peek :: (Show a) => St -> Stream a -> IO ()
-peek st s = do
-  cyc <- fmap fromIntegral (getCycle st)
-  let arc = Arc cyc (cyc + 1)
-      evs = streamRun s arc
-  prettyPrint arc
-  for_ evs (prettyPrint . fmap show)
+peek :: (Show a) => St -> EStream a -> IO ()
+peek st es =
+  case unEStream es of
+    Left e -> throwIO e
+    Right s -> do
+      cyc <- fmap fromIntegral (getCycle st)
+      let arc = Arc cyc (cyc + 1)
+          evs = streamRun s arc
+      prettyPrint arc
+      for_ evs (prettyPrint . fmap show)
 
 clearAllOrbitsSTM :: Domain -> STM ()
 clearAllOrbitsSTM dom = do

minipat-dirt/src/Minipat/Dirt/Prelude.hs

@@ -14,10 +14,11 @@ import Data.Text (Text)
 import Data.Text qualified as T
 import Looksee qualified as L
 import Minipat.Ast (Ident (..), Select (..))
-import Minipat.Classes (Flow (..), Pattern (..))
+import Minipat.Classes (Flow (..))
 import Minipat.Dirt.Attrs (Attr (..), Attrs, DatumProxy (..), IsAttrs (..))
 import Minipat.Dirt.Notes (ChordName, Note (..), OctNote (..), Octave (..), convChordName, convNoteName, octToNote)
-import Minipat.Eval (PatternEval, evalPat)
+import Minipat.EStream (EStream (..))
+import Minipat.Eval (evalPat)
 import Minipat.Parser (P, identP, selectP)
 
 -- Start with some private parsing stuff
@@ -31,10 +32,10 @@ datumP = \case
   DatumProxyString -> fmap unIdent identP
 
 -- TODO figure out out to propagate error
-parsePat :: (PatternEval f) => P a -> Text -> f a
-parsePat p = either (pure patEmpty) id . evalPat p
+parsePat :: P a -> Text -> EStream a
+parsePat p = EStream . evalPat p
 
-datumPat :: (PatternEval f) => DatumProxy a -> Text -> f a
+datumPat :: DatumProxy a -> Text -> EStream a
 datumPat = parsePat . datumP
 
 octNoteP :: P OctNote
@@ -65,20 +66,20 @@ ordP m pa =
 
 -- General combinators
 
-setIn, (#) :: (Flow f, IsAttrs a, IsAttrs b) => f a -> f b -> f Attrs
+setIn, (#) :: (IsAttrs a, IsAttrs b) => EStream a -> EStream b -> EStream Attrs
 setIn = flowInnerApply (\m1 m2 -> toAttrs m2 <> toAttrs m1)
 (#) = setIn
 
-pF :: (Pattern f, Real a) => Text -> f a -> f (Attr Float)
+pF :: (Real a) => Text -> EStream a -> EStream (Attr Float)
 pF k = fmap (Attr k . realToFrac)
 
-pI :: (Pattern f, Integral a) => Text -> f a -> f (Attr Int32)
+pI :: (Integral a) => Text -> EStream a -> EStream (Attr Int32)
 pI k = fmap (Attr k . fromIntegral)
 
-attrPat :: (Pattern f) => Text -> f a -> f (Attr a)
+attrPat :: Text -> EStream a -> EStream (Attr a)
 attrPat k = fmap (Attr k)
 
-datumAttrPat :: (PatternEval f) => DatumProxy a -> Text -> Text -> f (Attr a)
+datumAttrPat :: DatumProxy a -> Text -> Text -> EStream (Attr a)
 datumAttrPat dp k = attrPat k . datumPat dp
 
 -- Specific combinators
@@ -95,11 +96,11 @@ instance IsAttrs Sound where
 soundP :: P Sound
 soundP = fmap (\(Select so mn) -> Sound so mn) (selectP identP noteP)
 
-sound, s :: (PatternEval f) => Text -> f Sound
+sound, s :: Text -> EStream Sound
 sound = parsePat soundP
 s = sound
 
-note, n :: (PatternEval f) => Text -> f Note
+note, n :: Text -> EStream Note
 note = parsePat noteP
 n = note
 
@@ -119,10 +120,10 @@ arpMap = Map.fromList [("up", ArpUp), ("down", ArpDown)]
 arpP :: P Arp
 arpP = ordP arpMap (fmap unIdent identP)
 
-arp :: (PatternEval f) => Text -> f Arp
+arp :: Text -> EStream Arp
 arp = parsePat arpP
 
--- strum :: Stream Arp -> Stream Chord -> Stream Note
+-- strum :: f Arp -> f Chord -> f Note
 -- strum arps chords = undefined
 
 -- Params
@@ -159,7 +160,7 @@ accelerate
   , sustain
   , tremolodepth
   , tremolorate
-    :: (Pattern f, Real a) => f a -> f (Attr Float)
+    :: (Real a) => EStream a -> EStream (Attr Float)
 accelerate = pF "accelerate"
 attack = pF "attack"
 bandf = pF "bandf"
@@ -211,7 +212,7 @@ accel
   , sz
   , tremdp
   , tremr
-    :: (Pattern f, Real a) => f a -> f (Attr Float)
+    :: (Real a) => EStream a -> EStream (Attr Float)
 att = attack
 bpf = bandf
 bpq = bandq

minipat/src/Minipat/Classes.hs

@@ -7,7 +7,6 @@ where
 
 import Bowtie (pattern JotP)
 import Control.Applicative (Alternative (..))
-import Control.Monad.Identity (Identity (..))
 import Control.Monad.Reader (Reader, asks, runReader)
 import Data.Default (Default (..))
 import Data.Kind (Type)
@@ -28,8 +27,6 @@ import Minipat.Ast
   , UnPat
   , factorFromRational
   )
-import Minipat.EStream
-import Minipat.Stream
 import Minipat.Time (CycleDelta, CycleTime, MergeStrat (..))
 
 mkPat :: PatF b a (UnPat b a) -> Reader b (Pat b a)
@@ -134,10 +131,6 @@ class (Functor f, Monad (PatM f), Default (PatA f)) => Pattern f where
   patDegBy :: Rational -> f a -> f a
   patDegBy r = patCon . patDegBy' r
 
--- | Sometimes you can construct patterns with other types of annotations.
-class (Pattern f) => PatternUnwrap b f where
-  patUnwrap' :: PatM f (f a) -> b -> f a
-
 instance (Default b) => Pattern (Pat b) where
   type PatM (Pat b) = Reader b
   type PatA (Pat b) = b
@@ -157,53 +150,13 @@ instance (Default b) => Pattern (Pat b) where
   patDeg' = mkPatDeg
   patDegBy' = mkPatDegBy
 
+-- | Sometimes you can construct patterns with other types of annotations.
+class (Pattern f) => PatternUnwrap b f where
+  patUnwrap' :: PatM f (f a) -> b -> f a
+
 instance (Default b) => PatternUnwrap b (Pat b) where
   patUnwrap' = patCon'
 
-instance Pattern Stream where
-  type PatM Stream = Identity
-  type PatA Stream = ()
-  patCon' = const . runIdentity
-  patPure' = Identity . pure
-  patEmpty' = Identity mempty
-  patPar' = Identity . streamPar
-  patAlt' = Identity . streamAlt
-  patRand' = Identity . streamRand
-  patSeq' = Identity . streamSeq
-  patEuc' e = Identity . streamEuc e
-  patRep' r = Identity . streamRep r
-  patFast' p = Identity . streamFast p
-  patSlow' p = Identity . streamSlow p
-  patFastBy' r = Identity . streamFastBy r
-  patSlowBy' r = Identity . streamSlowBy r
-  patDeg' p = Identity . streamDeg p
-  patDegBy' r = Identity . streamDegBy r
-
-instance PatternUnwrap b Stream where
-  patUnwrap' = const . runIdentity
-
-instance Pattern EStream where
-  type PatM EStream = Identity
-  type PatA EStream = ()
-  patCon' = const . runIdentity
-  patPure' = Identity . pure
-  patEmpty' = Identity mempty
-  patPar' = Identity . estreamPar
-  patAlt' = Identity . estreamAlt
-  patRand' = Identity . estreamRand
-  patSeq' = Identity . estreamSeq
-  patEuc' e = Identity . estreamEuc e
-  patRep' r = Identity . estreamRep r
-  patFast' p = Identity . estreamFast p
-  patSlow' p = Identity . estreamSlow p
-  patFastBy' r = Identity . estreamFastBy r
-  patSlowBy' r = Identity . estreamSlowBy r
-  patDeg' p = Identity . estreamDeg p
-  patDegBy' r = Identity . estreamDegBy r
-
-instance PatternUnwrap b EStream where
-  patUnwrap' = const . runIdentity
-
 class (Alternative f, Pattern f) => Flow f where
   flowApply :: MergeStrat -> (a -> b -> c) -> f a -> f b -> f c
   flowInnerApply :: (a -> b -> c) -> f a -> f b -> f c
@@ -217,23 +170,3 @@ class (Alternative f, Pattern f) => Flow f where
   flowEarly, flowLate :: f CycleDelta -> f a -> f a
   flowSwitch :: f a -> CycleTime -> f a -> f a
   flowPieces :: f a -> Seq (CycleTime, f a) -> f a
-
-instance Flow Stream where
-  flowApply = streamApply
-  flowFilter = streamFilter
-  flowEarlyBy = streamEarlyBy
-  flowLateBy = streamLateBy
-  flowEarly = streamEarly
-  flowLate = streamLate
-  flowSwitch = streamSwitch
-  flowPieces = streamPieces
-
-instance Flow EStream where
-  flowApply = estreamApply
-  flowFilter = estreamFilter
-  flowEarlyBy = estreamEarlyBy
-  flowLateBy = estreamLateBy
-  flowEarly = estreamEarly
-  flowLate = estreamLate
-  flowSwitch = estreamSwitch
-  flowPieces = estreamPieces

minipat/src/Minipat/EStream.hs

@@ -6,10 +6,12 @@ module Minipat.EStream where
 
 import Control.Applicative (Alternative (..))
 import Control.Exception (Exception, SomeException (..))
+import Control.Monad.Identity (Identity (..))
 import Data.Kind (Type)
 import Data.Semigroup (Semigroup (..))
 import Data.Sequence (Seq)
 import Minipat.Ast (Euclid)
+import Minipat.Classes (Flow (..), Pattern (..), PatternUnwrap (..))
 import Minipat.Stream
 import Minipat.Stream qualified as S
 import Minipat.Time (CycleDelta, CycleTime, MergeStrat)
@@ -100,3 +102,35 @@ estreamSwitch e1 t = estreamLiftA2 (`streamSwitch` t) e1
 
 estreamPieces :: EStream a -> Seq (CycleTime, EStream a) -> EStream a
 estreamPieces e1 = EStream . liftA2 streamPieces (unEStream e1) . traverse (\(t, EStream e) -> fmap (t,) e)
+
+instance Pattern EStream where
+  type PatM EStream = Identity
+  type PatA EStream = ()
+  patCon' = const . runIdentity
+  patPure' = Identity . pure
+  patEmpty' = Identity mempty
+  patPar' = Identity . estreamPar
+  patAlt' = Identity . estreamAlt
+  patRand' = Identity . estreamRand
+  patSeq' = Identity . estreamSeq
+  patEuc' e = Identity . estreamEuc e
+  patRep' r = Identity . estreamRep r
+  patFast' p = Identity . estreamFast p
+  patSlow' p = Identity . estreamSlow p
+  patFastBy' r = Identity . estreamFastBy r
+  patSlowBy' r = Identity . estreamSlowBy r
+  patDeg' p = Identity . estreamDeg p
+  patDegBy' r = Identity . estreamDegBy r
+
+instance PatternUnwrap b EStream where
+  patUnwrap' = const . runIdentity
+
+instance Flow EStream where
+  flowApply = estreamApply
+  flowFilter = estreamFilter
+  flowEarlyBy = estreamEarlyBy
+  flowLateBy = estreamLateBy
+  flowEarly = estreamEarly
+  flowLate = estreamLate
+  flowSwitch = estreamSwitch
+  flowPieces = estreamPieces

minipat/src/Minipat/Stream.hs

@@ -47,13 +47,15 @@ where
 
 import Control.Applicative (Alternative (..))
 import Control.Monad (ap)
+import Control.Monad.Identity (Identity (..))
 import Data.Foldable (foldMap', foldl', toList)
 import Data.Heap (Entry (..), Heap)
 import Data.Heap qualified as H
 import Data.Semigroup (Semigroup (..))
 import Data.Sequence (Seq (..))
 import Data.Sequence qualified as Seq
 import Minipat.Ast (Euclid (..))
+import Minipat.Classes (Flow (..), Pattern (..), PatternUnwrap (..))
 import Minipat.Rand (arcSeed, randFrac, randInt, spanSeed)
 import Minipat.Time
   ( Arc (..)
@@ -296,3 +298,35 @@ streamPieces x = \case
 --
 -- streamSine :: (Floating a, Fractional a) => Rational -> Stream a
 -- streamSine = streamCont . fnSine
+
+instance Pattern Stream where
+  type PatM Stream = Identity
+  type PatA Stream = ()
+  patCon' = const . runIdentity
+  patPure' = Identity . pure
+  patEmpty' = Identity mempty
+  patPar' = Identity . streamPar
+  patAlt' = Identity . streamAlt
+  patRand' = Identity . streamRand
+  patSeq' = Identity . streamSeq
+  patEuc' e = Identity . streamEuc e
+  patRep' r = Identity . streamRep r
+  patFast' p = Identity . streamFast p
+  patSlow' p = Identity . streamSlow p
+  patFastBy' r = Identity . streamFastBy r
+  patSlowBy' r = Identity . streamSlowBy r
+  patDeg' p = Identity . streamDeg p
+  patDegBy' r = Identity . streamDegBy r
+
+instance PatternUnwrap b Stream where
+  patUnwrap' = const . runIdentity
+
+instance Flow Stream where
+  flowApply = streamApply
+  flowFilter = streamFilter
+  flowEarlyBy = streamEarlyBy
+  flowLateBy = streamLateBy
+  flowEarly = streamEarly
+  flowLate = streamLate
+  flowSwitch = streamSwitch
+  flowPieces = streamPieces