etc

README.md

@@ -4,22 +4,17 @@ A mini pattern language extracted from Tidal
 
 ## TODO
 
-* Impement `Alternative` for `Stream`
 * Finish Midi notes/chords/arps
+* Strongly typed `Attrs`
 * Implement polymeters
 * Handle errors gracefully in `minipat-dirt` loops
 * Additional combinators
   * `arp`
-  * `sustain`
-  * `room`
-  * `sz`
-  * `sustain`
-  * `legato`
   * `off`
   * `jux`
   * `|+` etc
   * `every`
   * `squiz`
   * `range`
-* Strongly typed `Attrs`
+* Impement `Alternative` for `Stream`
 

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

@@ -1,40 +1,43 @@
 -- {-# LANGUAGE OverloadedStrings #-}
 
-module Minipat.Dirt.Eval where
+module Minipat.Dirt.Eval
+  ( datumPat
+  )
+where
 
 -- ( liveEvalPat
 -- , liveEvalSoundPat
 -- , liveEvalNotePat
 -- )
 
--- import Control.Exception (Exception)
--- import Dahdit.Midi.Osc (Datum (..), DatumType (..))
--- import Data.Map.Strict qualified as Map
--- import Data.Text (Text)
--- import Data.Void (Void)
--- import Looksee (intP, sciP)
--- import Minipat.Ast (Ident (..), Pattern (..), Select (..))
--- import Minipat.Dirt.Notes (LinNote)
--- import Minipat.Dirt.Osc (Attrs)
--- import Minipat.Eval (evalPat)
--- import Minipat.Interp (InterpErr (..))
--- import Minipat.Parser (P, identP)
---
--- datumP :: DatumType -> P Datum
--- datumP = \case
---   DatumTypeInt32 -> fmap (DatumInt32 . fromInteger) intP
---   DatumTypeInt64 -> fmap (DatumInt64 . fromInteger) intP
---   DatumTypeFloat -> fmap (DatumFloat . realToFrac) sciP
---   DatumTypeDouble -> fmap (DatumDouble . realToFrac) sciP
---   DatumTypeString -> fmap (DatumString . unIdent) identP
---   dt -> fail ("Datum type is not parseable: " <> show dt)
---
--- forbidEvalEnv :: DatumType -> EvalEnv e Datum
--- forbidEvalEnv dt = EvalEnv forbidInterpEnv (datumP dt)
---
--- liveEvalPat :: (Pattern f) => DatumType -> Text -> f Datum
--- liveEvalPat dt txt = either (pure patEmpty) id (evalPat @_ @Void (forbidEvalEnv dt) txt)
---
+import Control.Exception (Exception)
+import Dahdit.Midi.Osc (Datum (..), DatumType (..))
+import Data.Map.Strict qualified as Map
+import Data.Text (Text)
+import Data.Void (Void)
+import Looksee (intP, sciP)
+import Minipat.Ast (Ident (..), Pattern (..), Select (..))
+import Minipat.Dirt.Notes (LinNote)
+import Minipat.Dirt.Osc (Attrs, DatumProxy (..))
+import Minipat.Eval (evalPat)
+import Minipat.Interp (InterpErr (..))
+import Minipat.Parser (P, identP)
+
+datumP :: DatumProxy a -> P a
+datumP = \case
+  DatumProxyInt32 -> fmap fromInteger intP
+  DatumProxyInt64 -> fmap fromInteger intP
+  DatumProxyFloat -> fmap realToFrac sciP
+  DatumProxyDouble -> fmap realToFrac sciP
+  DatumProxyString -> fmap unIdent identP
+
+-- TODO figure out out to propagate error
+parsePat :: (Pattern f) => P a -> Text -> f a
+parsePat p = either (pure patEmpty) id . evalPat p
+
+datumPat :: (Pattern f) => DatumProxy a -> Text -> f a
+datumPat = parsePat . datumP
+
 -- data SoundSelectErr = SoundSelectErr
 --   deriving stock (Eq, Ord, Show)
 --

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

@@ -1,8 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Minipat.Dirt.Osc
-  ( DatumTypeProxy (..)
-  , unDatumTypeProxy
+  ( DatumProxy (..)
+  , datumProxyType
   , Timed (..)
   , Attrs
   , attrs
@@ -23,7 +23,7 @@ import Control.Monad.Except (throwError)
 import Dahdit.Midi.Osc (Datum (..), DatumType (..), IsDatum (..), Msg (..), Packet (..))
 import Dahdit.Midi.OscAddr (RawAddrPat)
 import Data.Foldable (foldl')
-import Data.Int (Int32)
+import Data.Int (Int32, Int64)
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
 import Data.Sequence (Seq (..))
@@ -33,16 +33,20 @@ import Minipat.Stream (Ev (..), Tape, tapeToList)
 import Minipat.Time (CycleDelta (..), CycleTime (..), Span, spanCycle, spanDelta)
 import Nanotime (PosixTime, TimeDelta (..), addTime, timeDeltaFromFracSecs, timeDeltaToNanos)
 
-data DatumTypeProxy a where
-  DatumLikeInt32 :: DatumTypeProxy Int32
-  DatumLikeFloat :: DatumTypeProxy Float
-  DatumLikeString :: DatumTypeProxy Text
-
-unDatumTypeProxy :: DatumTypeProxy a -> DatumType
-unDatumTypeProxy = \case
-  DatumLikeInt32 -> DatumTypeInt32
-  DatumLikeFloat -> DatumTypeFloat
-  DatumLikeString -> DatumTypeString
+data DatumProxy a where
+  DatumProxyInt32 :: DatumProxy Int32
+  DatumProxyInt64 :: DatumProxy Int64
+  DatumProxyFloat :: DatumProxy Float
+  DatumProxyDouble :: DatumProxy Double
+  DatumProxyString :: DatumProxy Text
+
+datumProxyType :: DatumProxy a -> DatumType
+datumProxyType = \case
+  DatumProxyInt32 -> DatumTypeInt32
+  DatumProxyInt64 -> DatumTypeInt64
+  DatumProxyFloat -> DatumTypeFloat
+  DatumProxyDouble -> DatumTypeDouble
+  DatumProxyString -> DatumTypeString
 
 data Timed a = Timed
   { timedKey :: !PosixTime

minipat/src/Minipat/Ast.hs

@@ -5,7 +5,6 @@
 module Minipat.Ast
   ( Ident (..)
   , Select (..)
-  , Selected (..)
   , QuickRatio (..)
   , quickRatioValue
   , quickRatioRep
@@ -56,22 +55,17 @@ newtype Ident = Ident {unIdent :: Text}
   deriving stock (Show)
   deriving newtype (Eq, Ord, IsString, Pretty)
 
--- * Selects
+-- * Select
 
-data Select = SelectSample !Integer | SelectTransform !Ident
-  deriving stock (Eq, Ord, Show)
-
-instance Pretty Select where
-  pretty s =
-    ":" <> case s of
-      SelectSample i -> pretty i
-      SelectTransform t -> pretty t
-
-data Selected a = Selected !a !(Maybe Select)
+-- | A selection of some kind - note, transformation, etc.
+data Select s a = Select !a !(Maybe s)
   deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable)
 
-instance (Pretty a) => Pretty (Selected a) where
-  pretty (Selected a ms) = pretty a <> maybe mempty pretty ms
+instance (Pretty s, Pretty a) => Pretty (Select s a) where
+  pretty (Select a ms) =
+    case ms of
+      Nothing -> pretty a
+      Just s -> P.hcat [pretty a, ":", pretty s]
 
 -- * QuickRatio
 

minipat/src/Minipat/Parser.hs

@@ -9,19 +9,18 @@ module Minipat.Parser
   , PPat
   , topPatP
   , identPatP
+  , selectIdentPatP
   , factorP
   , identP
   , selectP
-  , selectedP
-  , selectedIdentPatP
   )
 where
 
 import Bowtie (Anno (..), Jot, pattern JotP)
 import Control.Exception (Exception)
-import Control.Monad (when)
+import Control.Monad (guard, when)
 import Control.Monad.Fix (fix)
-import Data.Char (isAlpha, isAlphaNum, isDigit, isSpace)
+import Data.Char (isAlpha, isAlphaNum, isSpace)
 import Data.Ratio (denominator, numerator)
 import Data.Sequence (Seq (..))
 import Data.Sequence qualified as Seq
@@ -109,9 +108,19 @@ tokP = L.charP_
 stripIdentP :: P Ident
 stripIdentP = L.stripEndP identP
 
+guardP :: (Char -> Bool) -> P ()
+guardP f = do
+  h <- L.lookP L.headP
+  guard (f h)
+
 identP :: P Ident
 identP = fmap Ident (L.takeWhile1P isIdentChar)
 
+selectP :: P a -> P s -> P (Select s a)
+selectP pa ps = do
+  a <- pa
+  fmap (Select a) (L.optP (tokP ':' *> ps))
+
 fracFactorP :: P Factor
 fracFactorP = do
   stripTokP '('
@@ -347,16 +356,6 @@ topPatP p = patP p (fix (\pf -> rePatP factorP pf pf))
 identPatP :: P (PPat Ident)
 identPatP = topPatP identP
 
-selectP :: P Select
-selectP = do
-  tokP ':'
-  isNum <- L.lookP (fmap isDigit L.headP)
-  if isNum
-    then fmap SelectSample L.uintP
-    else fmap SelectTransform identP
-
-selectedP :: P a -> P (Selected a)
-selectedP pa = Selected <$> pa <*> L.optP selectP
-
-selectedIdentPatP :: P (PPat (Selected Ident))
-selectedIdentPatP = topPatP (selectedP identP)
+-- | Parses a top-level pattern of identifiers with selections.
+selectIdentPatP :: P s -> P (PPat (Select s Ident))
+selectIdentPatP = topPatP . selectP identP

minipat/test/Main.hs

@@ -15,11 +15,11 @@ import Data.Maybe (fromMaybe)
 import Data.Ratio ((%))
 import Data.Sequence (Seq (..))
 import Data.Text (Text)
-import Looksee (Err, parse)
+import Looksee (Err, intP, parse)
 import Minipat.Ast
 import Minipat.Interp (interpPat)
 import Minipat.Norm (normPat)
-import Minipat.Parser (P, ParseErr, factorP, identP, identPatP, selectedIdentPatP)
+import Minipat.Parser (P, ParseErr, factorP, identP, identPatP, selectIdentPatP)
 import Minipat.Print (render)
 import Minipat.Stream (Ev (..), streamRun)
 import Minipat.Time (Arc (..), CycleTime (..), Span (..))
@@ -79,8 +79,8 @@ mkUnTPat = unPat . mkTPat
 tpatP :: P (TPat Ident)
 tpatP = fmap (first (const ())) identPatP
 
-tspatP :: P (TPat (Selected Ident))
-tspatP = fmap (first (const ())) selectedIdentPatP
+tspatP :: P (TPat (Select Integer Ident))
+tspatP = fmap (first (const ())) (selectIdentPatP intP)
 
 xPatIdent, yPatIdent :: UnTPat Ident
 xPatIdent = mkUnTPat (PatPure (Ident "x"))