From 05771a196fb91c9424122249afef85c8066bd73a Mon Sep 17 00:00:00 2001 From: Eric Conlon <37287+ejconlon@users.noreply.github.com> Date: Thu, 15 Feb 2024 17:54:28 -0800 Subject: [PATCH] estream --- minipat-dirt/minipat-dirt.cabal | 1 - minipat-dirt/src/Minipat/Dirt/Prelude.hs | 2 +- minipat-dirt/src/Minipat/Dirt/Strip.hs | 67 ------------ minipat/minipat.cabal | 4 +- .../src/Minipat/{Pattern.hs => Classes.hs} | 53 +++++++++- minipat/src/Minipat/EStream.hs | 100 ++++++++++++++++++ minipat/src/Minipat/Eval.hs | 2 +- minipat/src/Minipat/Flow.hs | 32 ------ minipat/src/Minipat/Interp.hs | 2 +- minipat/src/Minipat/Stream.hs | 21 ++-- minipat/src/Minipat/Ur.hs | 2 +- minipat/test/Main.hs | 2 +- 12 files changed, 169 insertions(+), 119 deletions(-) delete mode 100644 minipat-dirt/src/Minipat/Dirt/Strip.hs rename minipat/src/Minipat/{Pattern.hs => Classes.hs} (76%) create mode 100644 minipat/src/Minipat/EStream.hs delete mode 100644 minipat/src/Minipat/Flow.hs diff --git a/minipat-dirt/minipat-dirt.cabal b/minipat-dirt/minipat-dirt.cabal index 95c6067..a247c27 100644 --- a/minipat-dirt/minipat-dirt.cabal +++ b/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 diff --git a/minipat-dirt/src/Minipat/Dirt/Prelude.hs b/minipat-dirt/src/Minipat/Dirt/Prelude.hs index 4178bcc..ef4ce5a 100644 --- a/minipat-dirt/src/Minipat/Dirt/Prelude.hs +++ b/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 diff --git a/minipat-dirt/src/Minipat/Dirt/Strip.hs b/minipat-dirt/src/Minipat/Dirt/Strip.hs deleted file mode 100644 index 0e6c3f9..0000000 --- a/minipat-dirt/src/Minipat/Dirt/Strip.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# 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 diff --git a/minipat/minipat.cabal b/minipat/minipat.cabal index 8a1894b..1c0a788 100644 --- a/minipat/minipat.cabal +++ b/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 diff --git a/minipat/src/Minipat/Pattern.hs b/minipat/src/Minipat/Classes.hs similarity index 76% rename from minipat/src/Minipat/Pattern.hs rename to minipat/src/Minipat/Classes.hs index c409d5f..057a5e6 100644 --- a/minipat/src/Minipat/Pattern.hs +++ b/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 diff --git a/minipat/src/Minipat/EStream.hs b/minipat/src/Minipat/EStream.hs new file mode 100644 index 0000000..4cfdb55 --- /dev/null +++ b/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" diff --git a/minipat/src/Minipat/Eval.hs b/minipat/src/Minipat/Eval.hs index 24b8411..7c924c9 100644 --- a/minipat/src/Minipat/Eval.hs +++ b/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 diff --git a/minipat/src/Minipat/Flow.hs b/minipat/src/Minipat/Flow.hs deleted file mode 100644 index d6736e7..0000000 --- a/minipat/src/Minipat/Flow.hs +++ /dev/null @@ -1,32 +0,0 @@ -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 diff --git a/minipat/src/Minipat/Interp.hs b/minipat/src/Minipat/Interp.hs index 56ef0f8..05d3792 100644 --- a/minipat/src/Minipat/Interp.hs +++ b/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' diff --git a/minipat/src/Minipat/Stream.hs b/minipat/src/Minipat/Stream.hs index 1a0b3dd..343e8d5 100644 --- a/minipat/src/Minipat/Stream.hs +++ b/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 diff --git a/minipat/src/Minipat/Ur.hs b/minipat/src/Minipat/Ur.hs index 69bed0e..08f1713 100644 --- a/minipat/src/Minipat/Ur.hs +++ b/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 diff --git a/minipat/test/Main.hs b/minipat/test/Main.hs index f238dcc..56ef495 100644 --- a/minipat/test/Main.hs +++ b/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 (..))