From 692149d265c69ce2a6895b6a1bb078dc4c9bcee2 Mon Sep 17 00:00:00 2001
From: Eric Conlon <37287+ejconlon@users.noreply.github.com>
Date: Sun, 4 Feb 2024 12:53:53 -0800
Subject: [PATCH] interp

---
 minipat-dirt/minipat-dirt.cabal          |  2 +-
 minipat-dirt/src/Minipat/Dirt/EStream.hs | 56 ++++++++++++++++++++++++
 minipat-dirt/src/Minipat/Dirt/Eval.hs    | 12 ++---
 minipat-dirt/src/Minipat/Dirt/Flow.hs    | 56 ------------------------
 minipat/src/Minipat/Ast.hs               |  8 +++-
 minipat/src/Minipat/Class.hs             |  4 ++
 minipat/src/Minipat/Eval.hs              |  4 +-
 minipat/src/Minipat/Interp.hs            | 32 ++++++--------
 minipat/src/Minipat/Stream.hs            | 18 +++++---
 minipat/test/Main.hs                     |  4 +-
 10 files changed, 103 insertions(+), 93 deletions(-)
 create mode 100644 minipat-dirt/src/Minipat/Dirt/EStream.hs
 delete mode 100644 minipat-dirt/src/Minipat/Dirt/Flow.hs

diff --git a/minipat-dirt/minipat-dirt.cabal b/minipat-dirt/minipat-dirt.cabal
index 2f1bf48..412ad4c 100644
--- a/minipat-dirt/minipat-dirt.cabal
+++ b/minipat-dirt/minipat-dirt.cabal
@@ -25,8 +25,8 @@ source-repository head
 library
   exposed-modules:
       Minipat.Dirt.Core
+      Minipat.Dirt.EStream
       Minipat.Dirt.Eval
-      Minipat.Dirt.Flow
       Minipat.Dirt.Logger
       Minipat.Dirt.Notes
       Minipat.Dirt.Osc
diff --git a/minipat-dirt/src/Minipat/Dirt/EStream.hs b/minipat-dirt/src/Minipat/Dirt/EStream.hs
new file mode 100644
index 0000000..e062be1
--- /dev/null
+++ b/minipat-dirt/src/Minipat/Dirt/EStream.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Minipat.Dirt.EStream where
+
+import Control.Exception (Exception, SomeException (..))
+import Data.Kind (Type)
+import Data.Proxy (Proxy (..))
+import Data.Semigroup (Semigroup (..))
+import Data.String (IsString (..))
+import Data.Text (Text)
+import Data.Typeable (Typeable)
+import Minipat.Eval (EvalEnv, evalPat)
+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 EStream (k :: k1) (a :: Type) = EStream {unEStream :: Either SomeException (Stream a)}
+  deriving stock (Functor)
+
+type role EStream phantom nominal
+
+instance Applicative (EStream k) where
+  pure = EStream . Right . pure
+  liftA2 f (EStream ca) (EStream cb) = EStream (liftA2 (liftA2 f) ca cb)
+
+instance Semigroup (EStream k a) where
+  EStream es1 <> EStream es2 = EStream (liftA2 (<>) es1 es2)
+  sconcat = EStream . fmap sconcat . traverse unEStream
+
+instance Monoid (EStream k a) where
+  mempty = EStream (Right mempty)
+  mconcat = EStream . fmap mconcat . traverse unEStream
+
+estreamMap :: (Stream a -> Stream b) -> EStream k a -> EStream j b
+estreamMap f (EStream c) = EStream (fmap f c)
+
+estreamBind :: EStream k a -> (Stream a -> EStream j b) -> EStream j b
+estreamBind (EStream c) f = EStream (c >>= unEStream . f)
+
+estreamThrow :: (Exception e) => e -> EStream k a
+estreamThrow = EStream . Left . SomeException
+
+estreamFilter :: (a -> Bool) -> EStream k a -> EStream j a
+estreamFilter = estreamMap . S.streamFilter
+
+class EStreamEval k e a | k -> e a where
+  estreamEvalEnv :: Proxy k -> EvalEnv e a
+
+instance (EStreamEval k e a, Show e, Typeable e) => IsString (EStream k a) where
+  fromString = estreamEval @e (estreamEvalEnv (Proxy :: Proxy k)) . fromString
+
+estreamEval :: (Show e, Typeable e) => EvalEnv e a -> Text -> EStream k a
+estreamEval ee txt = EStream (evalPat ee txt)
diff --git a/minipat-dirt/src/Minipat/Dirt/Eval.hs b/minipat-dirt/src/Minipat/Dirt/Eval.hs
index 118f877..09b43ac 100644
--- a/minipat-dirt/src/Minipat/Dirt/Eval.hs
+++ b/minipat-dirt/src/Minipat/Dirt/Eval.hs
@@ -12,11 +12,11 @@ import Data.Text (Text)
 import Data.Void (Void)
 import Looksee (intP, sciP)
 import Minipat.Ast (Ident (..), Select (..))
+import Minipat.Class (Pattern (..))
 import Minipat.Dirt.Osc (Attrs)
 import Minipat.Eval (EvalEnv (..), evalPat)
 import Minipat.Interp (InterpEnv (..), InterpErr (..), forbidInterpEnv)
 import Minipat.Parser (P, identP)
-import Minipat.Stream (Stream)
 
 datumP :: DatumType -> P Datum
 datumP = \case
@@ -30,13 +30,13 @@ datumP = \case
 forbidEvalEnv :: DatumType -> EvalEnv e Datum
 forbidEvalEnv dt = EvalEnv forbidInterpEnv (datumP dt)
 
-liveEvalPat :: DatumType -> Text -> Stream Datum
-liveEvalPat dt txt = either (pure mempty) id (evalPat @Void (forbidEvalEnv dt) txt)
+liveEvalPat :: (Pattern f) => DatumType -> Text -> f Datum
+liveEvalPat dt txt = either (pure patEmpty) id (evalPat @_ @Void (forbidEvalEnv dt) txt)
 
 data SoundSelectErr = SoundSelectErr
   deriving stock (Eq, Ord, Show)
 
-soundSelFn :: Select -> Stream Attrs -> Either (InterpErr SoundSelectErr) (Stream Attrs)
+soundSelFn :: (Pattern f) => Select -> f Attrs -> Either (InterpErr SoundSelectErr) (f Attrs)
 soundSelFn sel attrs =
   case sel of
     SelectSample n -> Right (fmap (Map.insert "note" (DatumInt32 (fromIntegral n))) attrs)
@@ -51,5 +51,5 @@ soundInterpEnv = InterpEnv soundSelFn soundProjFn
 soundEvalEnv :: EvalEnv SoundSelectErr Attrs
 soundEvalEnv = EvalEnv soundInterpEnv identP
 
-liveEvalSoundPat :: Text -> Stream Attrs
-liveEvalSoundPat txt = either (pure mempty) id (evalPat soundEvalEnv txt)
+liveEvalSoundPat :: (Pattern f) => Text -> f Attrs
+liveEvalSoundPat txt = either (pure patEmpty) id (evalPat soundEvalEnv txt)
diff --git a/minipat-dirt/src/Minipat/Dirt/Flow.hs b/minipat-dirt/src/Minipat/Dirt/Flow.hs
deleted file mode 100644
index 20918e0..0000000
--- a/minipat-dirt/src/Minipat/Dirt/Flow.hs
+++ /dev/null
@@ -1,56 +0,0 @@
-{-# LANGUAGE RoleAnnotations #-}
-{-# LANGUAGE UndecidableInstances #-}
-
-module Minipat.Dirt.Flow where
-
-import Control.Exception (Exception, SomeException (..))
-import Data.Kind (Type)
-import Data.Proxy (Proxy (..))
-import Data.Semigroup (Semigroup (..))
-import Data.String (IsString (..))
-import Data.Text (Text)
-import Data.Typeable (Typeable)
-import Minipat.Eval (EvalEnv, evalPat)
-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 Flow (k :: k1) (a :: Type) = Flow {unFlow :: Either SomeException (Stream a)}
-  deriving stock (Functor)
-
-type role Flow phantom nominal
-
-instance Applicative (Flow k) where
-  pure = Flow . Right . pure
-  liftA2 f (Flow ca) (Flow cb) = Flow (liftA2 (liftA2 f) ca cb)
-
-instance Semigroup (Flow k a) where
-  Flow es1 <> Flow es2 = Flow (liftA2 (<>) es1 es2)
-  sconcat = Flow . fmap sconcat . traverse unFlow
-
-instance Monoid (Flow k a) where
-  mempty = Flow (Right mempty)
-  mconcat = Flow . fmap mconcat . traverse unFlow
-
-flowMap :: (Stream a -> Stream b) -> Flow k a -> Flow j b
-flowMap f (Flow c) = Flow (fmap f c)
-
-flowBind :: Flow k a -> (Stream a -> Flow j b) -> Flow j b
-flowBind (Flow c) f = Flow (c >>= unFlow . f)
-
-flowThrow :: (Exception e) => e -> Flow k a
-flowThrow = Flow . Left . SomeException
-
-flowFilter :: (a -> Bool) -> Flow k a -> Flow j a
-flowFilter = flowMap . S.streamFilter
-
-class FlowEval k e a | k -> e a where
-  flowEvalEnv :: Proxy k -> EvalEnv e a
-
-instance (FlowEval k e a, Show e, Typeable e) => IsString (Flow k a) where
-  fromString = flowEval @e (flowEvalEnv (Proxy :: Proxy k)) . fromString
-
-flowEval :: (Show e, Typeable e) => EvalEnv e a -> Text -> Flow k a
-flowEval ee txt = Flow (evalPat ee txt)
diff --git a/minipat/src/Minipat/Ast.hs b/minipat/src/Minipat/Ast.hs
index 330b3e9..7356308 100644
--- a/minipat/src/Minipat/Ast.hs
+++ b/minipat/src/Minipat/Ast.hs
@@ -475,7 +475,13 @@ instance (Monoid b) => Pattern (Pat b) where
   patEmpty = mkPat PatSilence
   patPar = mkPat . PatGroup . Group 0 GroupTypePar . fmap unPat
   patAlt = mkPat . PatGroup . Group 0 GroupTypeAlt . fmap unPat
-  patRand = error "TODO"
+  patRand = mkPat . PatGroup . Group 0 GroupTypeRand . fmap unPat
   patSeq = error "TODO"
   patEuc = error "TODO"
   patRep = error "TODO"
+  patFastBy = error "TODO"
+  patFast = error "TODO"
+  patSlowBy = error "TODO"
+  patSlow = error "TODO"
+  patDegBy = error "TODO"
+  patDeg = error "TODO"
diff --git a/minipat/src/Minipat/Class.hs b/minipat/src/Minipat/Class.hs
index 3674e68..8778cf0 100644
--- a/minipat/src/Minipat/Class.hs
+++ b/minipat/src/Minipat/Class.hs
@@ -13,3 +13,7 @@ class (Functor f) => Pattern f where
   patSeq :: NESeq (f a, CycleDelta) -> f a
   patEuc :: Int -> Int -> Maybe Int -> f a -> f a
   patRep :: Int -> f a -> f a
+  patFastBy, patSlowBy :: Rational -> f a -> f a
+  patFast, patSlow :: f Rational -> f a -> f a
+  patDegBy :: Rational -> f a -> f a
+  patDeg :: f Rational -> f a -> f a
diff --git a/minipat/src/Minipat/Eval.hs b/minipat/src/Minipat/Eval.hs
index 9b8c362..6d9ca05 100644
--- a/minipat/src/Minipat/Eval.hs
+++ b/minipat/src/Minipat/Eval.hs
@@ -9,16 +9,16 @@ import Control.Exception (SomeException (..))
 import Data.Text (Text)
 import Data.Typeable (Typeable)
 import Looksee (parse)
+import Minipat.Class (Pattern)
 import Minipat.Interp (InterpEnv, interpPat)
 import Minipat.Norm (normPat)
 import Minipat.Parser (P, topPatP)
-import Minipat.Stream (Stream)
 
 data EvalEnv e a where
   EvalEnv :: InterpEnv e z a -> P z -> EvalEnv e a
 
 -- | The canonical way to parse, normalize, and interpret patterns as streams
-evalPat :: (Show e, Typeable e) => EvalEnv e a -> Text -> Either SomeException (Stream a)
+evalPat :: (Pattern f, Show e, Typeable e) => EvalEnv e a -> Text -> Either SomeException (f a)
 evalPat (EvalEnv ie p) t = do
   pat <- either (Left . SomeException) Right (parse (topPatP p) t)
   let pat' = normPat pat
diff --git a/minipat/src/Minipat/Interp.hs b/minipat/src/Minipat/Interp.hs
index 6d8ff30..c289bfc 100644
--- a/minipat/src/Minipat/Interp.hs
+++ b/minipat/src/Minipat/Interp.hs
@@ -42,17 +42,10 @@ import Minipat.Ast
   )
 import Minipat.Class (Pattern (..))
 import Minipat.Rewrite (RwErr, RwT, rewriteM, throwRw)
-import Minipat.Stream
-  ( Stream (..)
-  , streamDegradeBy
-  , streamFast
-  , streamFastBy
-  , streamSlow
-  )
 import Minipat.Time (CycleDelta (..))
 
 -- | A function that processes a 'Select'
-type Sel e a = Select -> Stream a -> Either (InterpErr e) (Stream a)
+type Sel e a = forall f. (Pattern f) => Select -> f a -> Either (InterpErr e) (f a)
 
 data InterpEnv e a c = InterpEnv
   { ieSel :: !(Sel e c)
@@ -98,9 +91,10 @@ runM :: M b e a -> Either (RwErr (InterpErr e) b) a
 runM = runExcept
 
 lookInterp
-  :: InterpEnv e a c
-  -> PatX b a (M b e (Stream c, CycleDelta))
-  -> RwT b (M b e) (Stream c, CycleDelta)
+  :: (Pattern f)
+  => InterpEnv e a c
+  -> PatX b a (M b e (f c, CycleDelta))
+  -> RwT b (M b e) (f c, CycleDelta)
 lookInterp (InterpEnv sel proj) = \case
   PatPure a -> pure (patPure (proj a), 1)
   PatSilence -> pure (patEmpty, 1)
@@ -120,11 +114,11 @@ lookInterp (InterpEnv sel proj) = \case
       GroupTypeSeq _ -> pure (patSeq els', 1)
       GroupTypePar -> pure (patPar (fmap fst els'), 1)
       GroupTypeRand ->
-        let els'' = fmap (\(el, w) -> streamFastBy (unCycleDelta w) el) els'
+        let els'' = fmap (\(el, w) -> patFastBy (unCycleDelta w) el) els'
             s = patRand els''
         in  pure (s, 1)
       GroupTypeAlt ->
-        let els'' = fmap (\(el, w) -> streamFastBy (unCycleDelta w) el) els'
+        let els'' = fmap (\(el, w) -> patFastBy (unCycleDelta w) el) els'
             s = patAlt els''
         in  pure (s, 1)
   PatMod (Mod melw md) ->
@@ -132,8 +126,8 @@ lookInterp (InterpEnv sel proj) = \case
       ModTypeSpeed (Speed dir spat) -> do
         spat' <- lift (subInterp forbidInterpEnv spat)
         let f = case dir of
-              SpeedDirFast -> streamFast
-              SpeedDirSlow -> streamSlow
+              SpeedDirFast -> patFast
+              SpeedDirSlow -> patSlow
             spat'' = fmap factorValue spat'
         (el, w) <- lift melw
         pure (f spat'' el, w)
@@ -145,7 +139,7 @@ lookInterp (InterpEnv sel proj) = \case
       ModTypeDegrade (Degrade dd) -> do
         let d = maybe (1 % 2) factorValue dd
         (el, w) <- lift melw
-        let el' = streamDegradeBy d el
+        let el' = patDegBy d el
         pure (el', w)
       ModTypeEuclid euc -> do
         let (Euclid (fromInteger -> filled) (fromInteger -> steps) (fmap fromInteger -> mshift)) = euc
@@ -154,9 +148,9 @@ lookInterp (InterpEnv sel proj) = \case
         pure (s, fromIntegral steps)
   PatPoly (Poly _ _) -> error "TODO"
 
-subInterp :: InterpEnv e a c -> Pat b a -> M b e (Stream c)
+subInterp :: (Pattern f) => InterpEnv e a c -> Pat b a -> M b e (f c)
 subInterp env = fmap fst . rewriteM (lookInterp env) . unPat
 
--- | Interpret the given 'Pat' as a 'Stream'
-interpPat :: InterpEnv e a c -> Pat b a -> Either (RwErr (InterpErr e) b) (Stream c)
+-- | Interpret the given 'Pat' as any 'Pattern'
+interpPat :: (Pattern f) => InterpEnv e a c -> Pat b a -> Either (RwErr (InterpErr e) b) (f c)
 interpPat env = runM . subInterp env
diff --git a/minipat/src/Minipat/Stream.hs b/minipat/src/Minipat/Stream.hs
index c273331..b26d9be 100644
--- a/minipat/src/Minipat/Stream.hs
+++ b/minipat/src/Minipat/Stream.hs
@@ -34,8 +34,8 @@ module Minipat.Stream
   , streamLateBy
   , streamEarly
   , streamLate
-  , streamDegradeBy
-  , streamDegrade
+  , streamDegBy
+  , streamDeg
   , streamCont
   , streamEuc
   , streamRand
@@ -215,11 +215,11 @@ streamEarly, streamLate :: Stream CycleTime -> Stream a -> Stream a
 streamEarly = streamAdjust streamEarlyBy
 streamLate = streamAdjust streamLateBy
 
-streamDegradeBy :: Rational -> Stream a -> Stream a
-streamDegradeBy r (Stream k) = Stream (tapeDegradeBy r . k)
+streamDegBy :: Rational -> Stream a -> Stream a
+streamDegBy r (Stream k) = Stream (tapeDegradeBy r . k)
 
-streamDegrade :: Stream Rational -> Stream a -> Stream a
-streamDegrade = streamAdjust streamDegradeBy
+streamDeg :: Stream Rational -> Stream a -> Stream a
+streamDeg = streamAdjust streamDegBy
 
 streamSeq :: NESeq (Stream a, CycleDelta) -> Stream a
 streamSeq ss = Stream $ \arc ->
@@ -302,3 +302,9 @@ instance Pattern Stream where
   patSeq = streamSeq
   patEuc = streamEuc
   patRep = streamRep
+  patFastBy = streamFastBy
+  patSlowBy = streamSlowBy
+  patFast = streamFast
+  patSlow = streamSlow
+  patDegBy = streamDegBy
+  patDeg = streamDeg
diff --git a/minipat/test/Main.hs b/minipat/test/Main.hs
index 85e2440..25abe84 100644
--- a/minipat/test/Main.hs
+++ b/minipat/test/Main.hs
@@ -24,7 +24,7 @@ import Minipat.Interp (SelAcc, accInterpEnv, accProj, interpPat)
 import Minipat.Norm (normPat)
 import Minipat.Parser (P, ParseErr, factorP, identP, identPatP)
 import Minipat.Print (render)
-import Minipat.Stream (Ev (..), streamRun)
+import Minipat.Stream (Ev (..), Stream, streamRun)
 import Minipat.Time (Arc (..), CycleTime (..), Span (..))
 import Prettyprinter qualified as P
 import System.IO (BufferMode (..), hSetBuffering, stdout)
@@ -420,7 +420,7 @@ runPatInterpCase :: (TestName, Maybe Arc, Text, [Ev (SelAcc Ident)]) -> TestTree
 runPatInterpCase (n, mayArc, patStr, evs) = testCase n $ do
   pat <- either throwIO pure (parse tpatP patStr)
   let pat' = normPat pat
-  pat'' <- either throwIO pure (interpPat @Void accInterpEnv pat')
+  pat'' <- either throwIO pure (interpPat @Stream @Void accInterpEnv pat')
   let arc = fromMaybe (Arc 0 1) mayArc
       actualEvs = streamRun pat'' arc
   actualEvs @?= evs