estream

minipat-dirt/minipat-dirt.cabal

@@ -32,7 +32,6 @@ library
       Minipat.Dirt.Osc
       Minipat.Dirt.Prelude
       Minipat.Dirt.Resources
-      Minipat.Dirt.Strip
       Minipat.Dirt.Test
   other-modules:
       Paths_minipat_dirt

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

@@ -14,11 +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 (Pattern (..))
 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.Parser (P, identP, selectP)
-import Minipat.Pattern (Pattern (..))
 import Minipat.Stream (Stream (..), streamInnerBind)
 
 -- Start with some private parsing stuff

minipat/minipat.cabal

@@ -25,12 +25,12 @@ source-repository head
 library
   exposed-modules:
       Minipat.Ast
+      Minipat.Classes
+      Minipat.EStream
       Minipat.Eval
-      Minipat.Flow
       Minipat.Interp
       Minipat.Norm
       Minipat.Parser
-      Minipat.Pattern
       Minipat.Print
       Minipat.Rand
       Minipat.Rewrite

minipat/src/Minipat/Pattern.hs → minipat/src/Minipat/Classes.hs

@@ -1,10 +1,12 @@
-module Minipat.Pattern
+module Minipat.Classes
   ( Pattern (..)
   , PatternUnwrap (..)
+  , Flow (..)
   )
 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 (..))
@@ -26,7 +28,9 @@ import Minipat.Ast
   , UnPat
   , factorFromRational
   )
+import Minipat.EStream
 import Minipat.Stream
+import Minipat.Time (CycleDelta, CycleTime)
 
 mkPat :: PatF b a (UnPat b a) -> Reader b (Pat b a)
 mkPat pf = asks (\b -> Pat (JotP b pf))
@@ -177,3 +181,50 @@ instance Pattern Stream where
 
 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
+  flowFilter :: (a -> Bool) -> f a -> f a
+  flowEarlyBy, flowLateBy :: CycleDelta -> f a -> f a
+  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
+  flowFilter = streamFilter
+  flowEarlyBy = streamEarlyBy
+  flowLateBy = streamLateBy
+  flowEarly = streamEarly
+  flowLate = streamLate
+  flowSwitch = streamSwitch
+  flowPieces = streamPieces
+
+instance Flow EStream where
+  flowFilter = estreamFilter
+  flowEarlyBy = estreamEarlyBy
+  flowLateBy = estreamLateBy
+  flowEarly = estreamEarly
+  flowLate = estreamLate
+  flowSwitch = estreamSwitch
+  flowPieces = estreamPieces

minipat/src/Minipat/EStream.hs

@@ -0,0 +1,100 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+module Minipat.EStream where
+
+import Control.Applicative (Alternative (..))
+import Control.Exception (Exception, SomeException (..))
+import Data.Kind (Type)
+import Data.Semigroup (Semigroup (..))
+import Data.Sequence (Seq)
+import Minipat.Ast (Euclid)
+import Minipat.Stream
+import Minipat.Stream qualified as S
+import Minipat.Time (CycleDelta, CycleTime)
+
+-- Tracks errors in stream creation for later logging
+newtype EStream (a :: Type) = EStream {unEStream :: Either SomeException (Stream a)}
+  deriving stock (Functor)
+
+instance Applicative EStream where
+  pure = EStream . Right . pure
+  liftA2 f (EStream ca) (EStream cb) = EStream (liftA2 (liftA2 f) ca cb)
+
+instance Semigroup (EStream a) where
+  EStream es1 <> EStream es2 = EStream (liftA2 (<>) es1 es2)
+  sconcat = EStream . fmap sconcat . traverse unEStream
+
+instance Monoid (EStream a) where
+  mempty = EStream (Right mempty)
+  mconcat = EStream . fmap mconcat . traverse unEStream
+
+instance Alternative EStream where
+  empty = mempty
+  (<|>) = (<>)
+
+-- estreamCast :: EStream a -> EStream a
+-- estreamCast = coerce
+
+estreamMap :: (Stream a -> Stream b) -> EStream a -> EStream b
+estreamMap f (EStream s) = EStream (fmap f s)
+
+estreamLiftA2 :: (Stream a -> Stream b -> Stream b) -> EStream a -> EStream b -> EStream b
+estreamLiftA2 f (EStream s1) (EStream s2) = EStream (liftA2 f s1 s2)
+
+estreamBind :: EStream a -> (Stream a -> EStream b) -> EStream b
+estreamBind (EStream c) f = EStream (c >>= unEStream . f)
+
+estreamThrow :: (Exception e) => e -> EStream a
+estreamThrow = EStream . Left . SomeException
+
+estreamFilter :: (a -> Bool) -> EStream a -> EStream a
+estreamFilter = estreamMap . S.streamFilter
+
+estreamFastBy, estreamSlowBy :: Rational -> EStream a -> EStream a
+estreamFastBy = estreamMap . streamFastBy
+estreamSlowBy = estreamMap . streamSlowBy
+
+estreamFast, estreamSlow :: EStream Rational -> EStream a -> EStream a
+estreamFast = estreamLiftA2 streamFast
+estreamSlow = estreamLiftA2 streamSlow
+
+estreamEarlyBy, estreamLateBy :: CycleDelta -> EStream a -> EStream a
+estreamEarlyBy = estreamMap . streamEarlyBy
+estreamLateBy = estreamMap . streamLateBy
+
+estreamEarly, estreamLate :: EStream CycleDelta -> EStream a -> EStream a
+estreamEarly = estreamLiftA2 streamEarly
+estreamLate = estreamLiftA2 streamLate
+
+estreamDegBy :: Rational -> EStream a -> EStream a
+estreamDegBy = estreamMap . streamDegBy
+
+estreamDeg :: EStream Rational -> EStream a -> EStream a
+estreamDeg = estreamLiftA2 streamDeg
+
+estreamSeq :: Seq (EStream a, Rational) -> EStream a
+estreamSeq = error "TODO"
+
+estreamRep :: Integer -> EStream a -> EStream a
+estreamRep = estreamMap . streamRep
+
+estreamCont :: Integer -> (CycleTime -> a) -> EStream a
+estreamCont sr = EStream . Right . streamCont sr
+
+estreamEuc :: Euclid -> EStream a -> EStream a
+estreamEuc = estreamMap . streamEuc
+
+estreamRand :: Seq (EStream a) -> EStream a
+estreamRand = error "TODO"
+
+estreamAlt :: Seq (EStream a) -> EStream a
+estreamAlt = error "TODO"
+
+estreamPar :: Seq (EStream a) -> EStream a
+estreamPar = error "TODO"
+
+estreamSwitch :: EStream a -> CycleTime -> EStream a -> EStream a
+estreamSwitch = error "TODO"
+
+estreamPieces :: EStream a -> Seq (CycleTime, EStream a) -> EStream a
+estreamPieces = error "TODO"

minipat/src/Minipat/Eval.hs

@@ -8,10 +8,10 @@ where
 import Control.Exception (SomeException (..))
 import Data.Text (Text)
 import Looksee (parse)
+import Minipat.Classes (PatternUnwrap)
 import Minipat.Interp (interpPat)
 import Minipat.Norm (normPat)
 import Minipat.Parser (Loc, P, topPatP)
-import Minipat.Pattern (PatternUnwrap)
 
 type PatternEval = PatternUnwrap Loc
 

minipat/src/Minipat/Interp.hs

@@ -30,7 +30,7 @@ import Minipat.Ast
   , SpeedDir (..)
   , factorValue
   )
-import Minipat.Pattern (PatM, Pattern (..), PatternUnwrap (..))
+import Minipat.Classes (PatM, Pattern (..), PatternUnwrap (..))
 import Minipat.Rewrite (patRw)
 
 -- | An error interpreting a 'Pat' as a 'Stream'

minipat/src/Minipat/Stream.hs

@@ -93,6 +93,10 @@ instance Functor Tape where
 tapeNull :: Tape a -> Bool
 tapeNull = H.null . unTape
 
+-- TODO Actually sample at the given rate
+tapeCont :: Integer -> (CycleTime -> a) -> Arc -> Tape a
+tapeCont _ f arc = tapeSingleton (evCont f arc)
+
 tapeFilter :: (a -> Bool) -> Tape a -> Tape a
 tapeFilter f = Tape . H.filter (\(Entry _ a) -> f a) . unTape
 
@@ -235,8 +239,9 @@ streamRep n s = Stream $ \arc ->
         in  mconcat (fmap (\k -> tapeLateBy (fromIntegral k) t) [0 .. n - 1])
   in  mconcat (fmap go1 (spanSplit arc))
 
-streamCont :: (CycleTime -> a) -> Stream a
-streamCont f = Stream (tapeSingleton . evCont f)
+-- | Continuous function sampled a given number of times over each cycle
+streamCont :: Integer -> (CycleTime -> a) -> Stream a
+streamCont sr f = Stream (tapeCont sr f)
 
 -- TODO implement this more efficiently than just concatenation?
 streamEuc :: Euclid -> Stream a -> Stream a
@@ -286,14 +291,8 @@ streamPieces x = \case
   (t, x') :<| xs' -> streamSwitch x t (streamPieces x' xs')
 
 -- TODO move to module with continuous primitives
--- fnSine :: Rational -> Time -> Double
--- fnSine freq t = sin (2 * pi * fromRational (freq * t))
+-- fnSine :: (Floating a, Fractional a) :: Rational -> CycleTime -> a
+-- fnSine freq t = sin (2 * pi * fromRational (freq * unCycleTime t))
 --
--- streamSine :: Rational -> Stream Double
+-- streamSine :: (Floating a, Fractional a) => Rational -> Stream a
 -- streamSine = streamCont . fnSine
-
--- streamDeriv :: Num n => Stream n -> Stream n
--- streamDeriv = undefined
---
--- streamInteg :: Num n => Stream n -> Stream n
--- streamInteg = undefined

minipat/src/Minipat/Ur.hs

@@ -10,10 +10,10 @@ import Data.Map.Strict qualified as Map
 import Data.Text (Text)
 import Data.Typeable (Typeable)
 import Minipat.Ast (Ident, Pat, Select (..))
+import Minipat.Classes (Pattern (..), PatternUnwrap (..))
 import Minipat.Eval (PatternEval, evalPat)
 import Minipat.Interp (InterpErr, customInterpPat)
 import Minipat.Parser (Loc, identP, selectP)
-import Minipat.Pattern (Pattern (..), PatternUnwrap (..))
 import Minipat.Time (CycleDelta (..))
 
 data UrErr k

minipat/test/Main.hs

@@ -19,11 +19,11 @@ import Data.Sequence (Seq (..))
 import Data.Text (Text)
 import Looksee (Err, intP, parse)
 import Minipat.Ast
+import Minipat.Classes (Pattern (..))
 import Minipat.Eval (evalPat)
 import Minipat.Interp (interpPat)
 import Minipat.Norm (normPat)
 import Minipat.Parser (Loc, P, ParseErr, factorP, identP, identPatP, selectIdentPatP)
-import Minipat.Pattern (Pattern (..))
 import Minipat.Print (prettyShow)
 import Minipat.Stream (Ev (..), Stream, streamRun)
 import Minipat.Time (Arc (..), CycleTime (..), Span (..))