etc

minipat-dirt/minipat-dirt.cabal

@@ -27,12 +27,12 @@ library
       Minipat.Dirt.Attrs
       Minipat.Dirt.Boot
       Minipat.Dirt.Core
-      Minipat.Dirt.EStream
       Minipat.Dirt.Logger
       Minipat.Dirt.Notes
       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/Strip.hs

@@ -0,0 +1,67 @@
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Minipat.Dirt.Strip where
+
+import Control.Applicative (Alternative (..))
+import Control.Exception (Exception, SomeException (..))
+import Data.Coerce (coerce)
+import Data.Kind (Type)
+import Data.Proxy (Proxy (..))
+import Data.Semigroup (Semigroup (..))
+import Data.String (IsString (..))
+import Data.Text (Text)
+import Minipat.Eval (evalPat)
+import Minipat.Parser (P)
+import Minipat.Stream (Stream)
+import Minipat.Stream qualified as S
+
+-- Attempting to add a few things to Streams
+-- 1) Tracking errors for later logging
+-- 2) IsString instance for seamless parsing
+newtype Strip (k :: k1) (a :: Type) = Strip {unStrip :: Either SomeException (Stream a)}
+  deriving stock (Functor)
+
+type role Strip phantom nominal
+
+instance Applicative (Strip k) where
+  pure = Strip . Right . pure
+  liftA2 f (Strip ca) (Strip cb) = Strip (liftA2 (liftA2 f) ca cb)
+
+instance Semigroup (Strip k a) where
+  Strip es1 <> Strip es2 = Strip (liftA2 (<>) es1 es2)
+  sconcat = Strip . fmap sconcat . traverse unStrip
+
+instance Monoid (Strip k a) where
+  mempty = Strip (Right mempty)
+  mconcat = Strip . fmap mconcat . traverse unStrip
+
+instance Alternative (Strip k) where
+  empty = mempty
+  (<|>) = (<>)
+
+stripCast :: Strip k a -> Strip j a
+stripCast = coerce
+
+stripMap :: (Stream a -> Stream b) -> Strip k a -> Strip j b
+stripMap f (Strip c) = Strip (fmap f c)
+
+stripBind :: Strip k a -> (Stream a -> Strip j b) -> Strip j b
+stripBind (Strip c) f = Strip (c >>= unStrip . f)
+
+stripThrow :: (Exception e) => e -> Strip k a
+stripThrow = Strip . Left . SomeException
+
+stripFilter :: (a -> Bool) -> Strip k a -> Strip j a
+stripFilter = stripMap . S.streamFilter
+
+class StripParse k a | k -> a where
+  stripParse :: Proxy k -> Text -> Strip k a
+
+instance (StripParse k a) => IsString (Strip k a) where
+  fromString = stripParse (Proxy :: Proxy k) . fromString
+
+stripEval :: P a -> Text -> Strip k a
+stripEval ee txt = Strip (evalPat ee txt)
+
+-- instance Pattern (Strip k) where

minipat/minipat.cabal

@@ -26,6 +26,7 @@ library
   exposed-modules:
       Minipat.Ast
       Minipat.Eval
+      Minipat.Flow
       Minipat.Interp
       Minipat.Norm
       Minipat.Parser

minipat/src/Minipat/Flow.hs

@@ -0,0 +1,32 @@
+module Minipat.Flow where
+
+import Control.Applicative (Alternative)
+import Data.Sequence (Seq)
+import Minipat.Pattern (Pattern)
+import Minipat.Stream
+  ( Stream
+  , streamEarly
+  , streamEarlyBy
+  , streamFilter
+  , streamLate
+  , streamLateBy
+  , streamPieces
+  , streamSwitch
+  )
+import Minipat.Time (CycleDelta, CycleTime)
+
+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

minipat/src/Minipat/Pattern.hs

@@ -5,9 +5,9 @@ module Minipat.Pattern
 where
 
 import Bowtie (pattern JotP)
+import Control.Monad.Identity (Identity (..))
 import Control.Monad.Reader (Reader, asks, runReader)
 import Data.Default (Default (..))
-import Data.Foldable (toList)
 import Data.Kind (Type)
 import Data.Sequence (Seq (..))
 import Minipat.Ast
@@ -26,6 +26,7 @@ import Minipat.Ast
   , UnPat
   , factorFromRational
   )
+import Minipat.Stream
 
 mkPat :: PatF b a (UnPat b a) -> Reader b (Pat b a)
 mkPat pf = asks (\b -> Pat (JotP b pf))
@@ -39,22 +40,34 @@ mkPatGroup gt = \case
 mkPatMod :: ModType b -> Pat b a -> Reader b (Pat b a)
 mkPatMod mt (Pat pa) = mkPat (PatMod (Mod pa mt))
 
+mkPatSpeedBy :: (Default b) => SpeedDir -> Rational -> Pat b a -> Reader b (Pat b a)
+mkPatSpeedBy sd f p =
+  if f == 1
+    then pure p
+    else mkPatSpeed sd (patPure f) p
+
 mkPatSpeed :: SpeedDir -> Pat b Rational -> Pat b a -> Reader b (Pat b a)
 mkPatSpeed sd pf = mkPatMod (ModTypeSpeed (Speed sd (fmap factorFromRational pf)))
 
+mkPatDegBy :: (Default b) => Rational -> Pat b a -> Reader b (Pat b a)
+mkPatDegBy f p =
+  if
+    | f <= 0 -> patEmpty'
+    | f >= 1 -> pure p
+    | otherwise -> mkPatDeg (patPure f) p
+
 mkPatDeg :: Pat b Rational -> Pat b a -> Reader b (Pat b a)
 mkPatDeg pf = mkPatMod (ModTypeDegrade (Degrade (Just (fmap factorFromRational pf))))
 
 mkPatRep :: Integer -> Pat b a -> Reader b (Pat b a)
 mkPatRep n = mkPatMod (ModTypeReplicate (Replicate (Just n)))
 
-mkPatSeq :: (Default b) => Seq (Pat b a, Rational) -> Reader b (Pat b a)
+mkPatSeq :: Seq (Pat b a, Rational) -> Reader b (Pat b a)
 mkPatSeq = \case
   Empty -> mkPat PatSilence
   (x, _) :<| Empty -> pure x
   xs ->
-    let w = sum (fmap snd (toList xs))
-        adjust (x, _) = unPat x
+    let adjust = unPat . fst
     in  mkPat (PatGroup (Group 1 (GroupTypeSeq SeqPresSpace) (fmap adjust xs)))
 
 -- | 'Pat' and 'Stream' can be constructed abstractly with this
@@ -135,10 +148,32 @@ instance (Default b) => Pattern (Pat b) where
   patRep' = mkPatRep
   patFast' = mkPatSpeed SpeedDirFast
   patSlow' = mkPatSpeed SpeedDirSlow
-  patFastBy' = patFast' . patPure -- patFast . patPure
-  patSlowBy' = patSlow' . patPure -- patSlow . patPure
+  patFastBy' = mkPatSpeedBy SpeedDirFast
+  patSlowBy' = mkPatSpeedBy SpeedDirSlow
   patDeg' = mkPatDeg
-  patDegBy' = patDeg' . patPure
+  patDegBy' = mkPatDegBy
 
 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

minipat/src/Minipat/Stream.hs

@@ -41,20 +41,20 @@ module Minipat.Stream
   , streamRand
   , streamAlt
   , streamPar
+  , streamSwitch
+  , streamPieces
   )
 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 Data.String (IsString (..))
 import Minipat.Ast (Euclid (..))
-import Minipat.Pattern (Pattern (..), PatternUnwrap (..))
 import Minipat.Rand (arcSeed, randFrac, randInt, spanSeed)
 import Minipat.Time
   ( Arc (..)
@@ -160,21 +160,9 @@ instance Monoid (Stream a) where
   mempty = Stream (const mempty)
   mconcat ss = Stream (\arc -> mconcat (fmap (`unStream` arc) ss))
 
--- TODO alt should be invariant under shifts, but that is expensive
--- -- | 'empty', like 'mempty', is the empty stream
--- instance Alternative Stream where
---   empty = mempty
---   Stream k1 <|> Stream k2 = Stream (foldl' merge mempty . spanSplit) where
---     merge t0 (_, Span arc _) =
---       let t1 = k1 arc
---           t2 = if tapeNull t1 then k2 arc else t1
---       in t0 <> t2
-
-instance (IsString s) => IsString (Stream s) where
-  fromString = pure . fromString
-
--- LAW TO VERIFY
--- forall p a. streamRun p a == spanSplit a >>= \(_, a') -> fmap (_) (streamRun p a')
+instance Alternative Stream where
+  empty = mempty
+  (<|>) = (<>)
 
 streamFilter :: (a -> Bool) -> Stream a -> Stream a
 streamFilter f (Stream k) = Stream (tapeFilter f . k)
@@ -212,11 +200,11 @@ streamFast, streamSlow :: Stream Rational -> Stream a -> Stream a
 streamFast = streamAdjust streamFastBy
 streamSlow = streamAdjust streamSlowBy
 
-streamEarlyBy, streamLateBy :: CycleTime -> Stream a -> Stream a
-streamEarlyBy t = streamTimeMapInv id (subtract t)
-streamLateBy t = streamTimeMapInv id (+ t)
+streamEarlyBy, streamLateBy :: CycleDelta -> Stream a -> Stream a
+streamEarlyBy (CycleDelta t) = streamTimeMapInv id (CycleTime . subtract t . unCycleTime)
+streamLateBy (CycleDelta t) = streamTimeMapInv id (CycleTime . (+ t) . unCycleTime)
 
-streamEarly, streamLate :: Stream CycleTime -> Stream a -> Stream a
+streamEarly, streamLate :: Stream CycleDelta -> Stream a -> Stream a
 streamEarly = streamAdjust streamEarlyBy
 streamLate = streamAdjust streamLateBy
 
@@ -309,25 +297,3 @@ streamPieces x = \case
 --
 -- streamInteg :: Num n => Stream n -> Stream n
 -- streamInteg = undefined
-
-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