etc

BootDirt.hs

@@ -2,26 +2,22 @@
 :set -fno-warn-orphans
 :set -XOverloadedLists
 :set -XOverloadedStrings
+:set -XTypeFamilies
 :set prompt "> "
 :set prompt-cont "| "
 
-import Data.Map.Strict (Map)
-import Data.Map.Strict qualified as Map
-import Data.Ratio ((%))
-import Data.Sequence (Seq)
-import Data.Sequence qualified as Seq
-import Minipat.Dirt.Prelude
+import Minipat.Dirt.Boot
 
 putStrLn "==== Minipat ==============================================="
 putStrLn "Quit with Ctrl-d or `:quit`"
 putStrLn "Clear stream with `hush` or stop with `panic`"
-putStrLn "List available functions with `:browse Minipat.Dirt.Prelude`"
+putStrLn "List available functions with `:browse Minipat.Dirt.Boot`"
 putStrLn "Show documentation with `:doc someFunctionName`"
 putStrLn "============================================================"
 
-minipatInst <- initialize
+dirtSt <- initialize
 
-instance Minipat where minipat = minipatInst
+instance LiveSt where { type LiveEnv = DirtEnv; type LiveData = DirtData; liveSt = dirtSt }
 
 handshake
 

minipat-dirt/minipat-dirt.cabal

@@ -26,9 +26,9 @@ library
   exposed-modules:
       Minipat.Dirt.Boot
       Minipat.Dirt.Impl
-      Minipat.Dirt.Prelude
       Minipat.Dirt.Test
       Minipat.Live.Attrs
+      Minipat.Live.Boot
       Minipat.Live.Combinators
       Minipat.Live.Core
       Minipat.Live.Logger

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

@@ -1,105 +1,27 @@
 {-# LANGUAGE OverloadedStrings #-}
 
--- | Controls for the live system
-module Minipat.Dirt.Boot where
+module Minipat.Dirt.Boot
+  ( D.DirtEnv
+  , D.DirtData
+  , DirtLiveSt
+  , initialize
+  , handshake
+  , module Minipat.Live.Boot
+  )
+where
 
 import Minipat.Dirt.Impl qualified as D
-import Minipat.EStream (EStream)
-import Minipat.Live.Attrs (Attrs, IsAttrs (..))
+import Minipat.Live.Boot
 import Minipat.Live.Core qualified as C
 import Minipat.Live.Logger qualified as L
-import Minipat.Stream (Stream)
-import Nanotime (TimeDelta)
-import Prettyprinter (Pretty)
 
-class Minipat where
-  minipat :: D.DirtSt
+type DirtLiveSt = (LiveSt, LiveEnv ~ D.DirtEnv, LiveData ~ D.DirtData)
 
 initialize :: IO D.DirtSt
 initialize = do
   logger <- L.newLogger
   L.logInfo logger "Initializing"
-  C.initSt logger D.dirtImpl (C.defaultEnv D.defaultDirtEnv)
+  C.initAsyncSt logger D.dirtImpl (C.defaultEnv D.defaultDirtEnv)
 
-dispose :: (Minipat) => IO ()
-dispose = C.disposeSt minipat
-
-getDebug :: (Minipat) => IO Bool
-getDebug = C.getDebug minipat
-
-getCps :: (Minipat) => IO Rational
-getCps = C.getCps minipat
-
-getAhead :: (Minipat) => IO TimeDelta
-getAhead = C.getAhead minipat
-
-getPlaying :: (Minipat) => IO Bool
-getPlaying = C.getPlaying minipat
-
-getStream :: (Minipat) => IO (Stream Attrs)
-getStream = C.getStream minipat
-
-getCycle :: (Minipat) => IO Integer
-getCycle = C.getCycle minipat
-
-getTempo :: (Minipat) => IO Rational
-getTempo = C.getTempo minipat
-
-setDebug :: (Minipat) => Bool -> IO ()
-setDebug = C.setDebug minipat
-
-setCps :: (Minipat) => Rational -> IO ()
-setCps = C.setCps minipat
-
-setPlaying :: (Minipat) => Bool -> IO ()
-setPlaying = C.setPlaying minipat
-
-setCycle :: (Minipat) => Integer -> IO ()
-setCycle = C.setCycle minipat
-
-setTempo :: (Minipat) => Rational -> IO ()
-setTempo = C.setTempo minipat
-
-setOrbit :: (Minipat) => Integer -> EStream Attrs -> IO ()
-setOrbit = C.setOrbit minipat
-
-clearOrbit :: (Minipat) => Integer -> IO ()
-clearOrbit = C.clearOrbit minipat
-
-clearAllOrbits :: (Minipat) => IO ()
-clearAllOrbits = C.clearAllOrbits minipat
-
-hush :: (Minipat) => IO ()
-hush = C.hush minipat
-
-panic :: (Minipat) => IO ()
-panic = C.panic minipat
-
-play :: (Minipat) => IO ()
-play = setPlaying True
-
-stop :: (Minipat) => IO ()
-stop = setPlaying False
-
-handshake :: (Minipat) => IO ()
-handshake = D.handshake minipat
-
-checkTasks :: (Minipat) => IO ()
-checkTasks = C.checkTasks minipat
-
--- | Prints the stream's events that would be generated in the current cycle
-peek :: (Minipat, Pretty a) => EStream a -> IO ()
-peek = C.peek minipat
-
-d :: (Minipat, IsAttrs a) => Integer -> EStream a -> IO ()
-d i = setOrbit i . fmap toAttrs
-
-d0, d1, d2, d3, d4, d5, d6, d7 :: (Minipat, IsAttrs a) => EStream a -> IO ()
-d0 = d 0
-d1 = d 1
-d2 = d 2
-d3 = d 3
-d4 = d 4
-d5 = d 5
-d6 = d 6
-d7 = d 7
+handshake :: (DirtLiveSt) => IO ()
+handshake = D.handshake liveSt

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

@@ -4,6 +4,7 @@
 module Minipat.Dirt.Impl
   ( DirtEnv (..)
   , defaultDirtEnv
+  , DirtData
   , DirtSt
   , dirtImpl
   , handshake
@@ -46,9 +47,11 @@ data OscConn = OscConn
   , ocListenConn :: !(Conn NS.SockAddr)
   }
 
-type DirtSt = St DirtEnv OscConn
+type DirtData = OscConn
 
-dirtInit :: LogAction -> RelVar -> DirtEnv -> IO OscConn
+type DirtSt = St DirtEnv DirtData
+
+dirtInit :: LogAction -> RelVar -> DirtEnv -> IO DirtData
 dirtInit _ rv (DirtEnv targetHp listenHp _) = do
   targetAddr <- resolveAddr targetHp
   relVarAcquire rv $ do

minipat-dirt/src/Minipat/Live/Boot.hs

@@ -0,0 +1,133 @@
+-- | Controls and prelude for the live system
+module Minipat.Live.Boot
+  ( LiveSt (..)
+  , dispose
+  , getDebug
+  , getCps
+  , getAhead
+  , getPlaying
+  , getStream
+  , getCycle
+  , getTempo
+  , setDebug
+  , setCps
+  , setPlaying
+  , setCycle
+  , setTempo
+  , setOrbit
+  , clearOrbit
+  , clearAllOrbits
+  , hush
+  , panic
+  , play
+  , stop
+  , checkTasks
+  , peek
+  , d
+  , d0
+  , d1
+  , d2
+  , d3
+  , d4
+  , d5
+  , d6
+  , d7
+  , module Minipat.Live.Combinators
+  , module Minipat.Live.Params
+  )
+where
+
+import Data.Kind (Type)
+import Minipat.EStream (EStream)
+import Minipat.Live.Attrs (Attrs, IsAttrs (..))
+import Minipat.Live.Combinators
+import Minipat.Live.Core qualified as C
+import Minipat.Live.Params
+import Minipat.Stream (Stream)
+import Nanotime (TimeDelta)
+import Prettyprinter (Pretty)
+
+class LiveSt where
+  type LiveEnv :: Type
+  type LiveData :: Type
+  liveSt :: C.St LiveEnv LiveData
+
+dispose :: (LiveSt) => IO ()
+dispose = C.disposeSt liveSt
+
+getDebug :: (LiveSt) => IO Bool
+getDebug = C.getDebug liveSt
+
+getCps :: (LiveSt) => IO Rational
+getCps = C.getCps liveSt
+
+getAhead :: (LiveSt) => IO TimeDelta
+getAhead = C.getAhead liveSt
+
+getPlaying :: (LiveSt) => IO Bool
+getPlaying = C.getPlaying liveSt
+
+getStream :: (LiveSt) => IO (Stream Attrs)
+getStream = C.getStream liveSt
+
+getCycle :: (LiveSt) => IO Integer
+getCycle = C.getCycle liveSt
+
+getTempo :: (LiveSt) => IO Rational
+getTempo = C.getTempo liveSt
+
+setDebug :: (LiveSt) => Bool -> IO ()
+setDebug = C.setDebug liveSt
+
+setCps :: (LiveSt) => Rational -> IO ()
+setCps = C.setCps liveSt
+
+setPlaying :: (LiveSt) => Bool -> IO ()
+setPlaying = C.setPlaying liveSt
+
+setCycle :: (LiveSt) => Integer -> IO ()
+setCycle = C.setCycle liveSt
+
+setTempo :: (LiveSt) => Rational -> IO ()
+setTempo = C.setTempo liveSt
+
+setOrbit :: (LiveSt) => Integer -> EStream Attrs -> IO ()
+setOrbit = C.setOrbit liveSt
+
+clearOrbit :: (LiveSt) => Integer -> IO ()
+clearOrbit = C.clearOrbit liveSt
+
+clearAllOrbits :: (LiveSt) => IO ()
+clearAllOrbits = C.clearAllOrbits liveSt
+
+hush :: (LiveSt) => IO ()
+hush = C.hush liveSt
+
+panic :: (LiveSt) => IO ()
+panic = C.panic liveSt
+
+play :: (LiveSt) => IO ()
+play = setPlaying True
+
+stop :: (LiveSt) => IO ()
+stop = setPlaying False
+
+checkTasks :: (LiveSt) => IO ()
+checkTasks = C.checkTasks liveSt
+
+-- | Prints the stream's events that would be generated in the current cycle
+peek :: (LiveSt, Pretty a) => EStream a -> IO ()
+peek = C.peek liveSt
+
+d :: (LiveSt, IsAttrs a) => Integer -> EStream a -> IO ()
+d i = setOrbit i . fmap toAttrs
+
+d0, d1, d2, d3, d4, d5, d6, d7 :: (LiveSt, IsAttrs a) => EStream a -> IO ()
+d0 = d 0
+d1 = d 1
+d2 = d 2
+d3 = d 3
+d4 = d 4
+d5 = d 5
+d6 = d 6
+d7 = d 7