csound-expression-typed 0.2.7 → 0.2.7.1

raw patch · 31 files changed

+550/−531 lines, 31 filesdep +bytestringdep +textdep +wl-pprint-textdep −wl-pprintPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bytestring, text, wl-pprint-text

Dependencies removed: wl-pprint

API changes (from Hackage documentation)

Files

• csound-expression-typed.cabal +13/−7
• src/Csound/Typed/Control.hs +9/−16
• src/Csound/Typed/Control/Api.hs +11/−10
• src/Csound/Typed/Control/ArrayTraverse.hs +2/−4
• src/Csound/Typed/Control/Instr.hs +10/−14
• src/Csound/Typed/Control/MacrosArgs.hs +4/−3
• src/Csound/Typed/Control/Mix.hs +5/−10
• src/Csound/Typed/Control/Ref.hs +12/−12
• src/Csound/Typed/Control/Sf2.hs +7/−6
• src/Csound/Typed/GlobalState/Elements.hs +38/−65
• src/Csound/Typed/GlobalState/GE.hs +41/−43
• src/Csound/Typed/GlobalState/Opcodes.hs +20/−17
• src/Csound/Typed/GlobalState/Options.hs +19/−14
• src/Csound/Typed/GlobalState/Port.hs +13/−12
• src/Csound/Typed/GlobalState/SE.hs +1/−2
• src/Csound/Typed/Gui/BoxModel.hs +10/−11
• src/Csound/Typed/Gui/Cabbage/Cabbage.hs +22/−21
• src/Csound/Typed/Gui/Cabbage/CabbageLang.hs +8/−7
• src/Csound/Typed/Gui/Gui.hs +19/−15
• src/Csound/Typed/Gui/Pretty.hs +11/−10
• src/Csound/Typed/Gui/Types.hs +6/−5
• src/Csound/Typed/Gui/Widget.hs +49/−47
• src/Csound/Typed/Render.hs +15/−8
• src/Csound/Typed/Types.hs +10/−8
• src/Csound/Typed/Types/Array.hs +12/−10
• src/Csound/Typed/Types/Evt.hs +9/−8
• src/Csound/Typed/Types/Lift.hs +8/−11
• src/Csound/Typed/Types/Prim.hs +39/−85
• src/Csound/Typed/Types/PureArray.hs +70/−0
• src/Csound/Typed/Types/SigSpace.hs +2/−1
• src/Csound/Typed/Types/Tuple.hs +55/−49

@@ -1,6 +1,6 @@ Name:          csound-expression-typed-Version:       0.2.7-Cabal-Version: >= 1.22+Version:       0.2.7.1+Cabal-Version: 1.12 License:       BSD3 License-file:  LICENSE Author:	       Anton Kholomiov@@ -67,8 +67,9 @@ Library   Ghc-Options:    -Wall   Build-Depends:-        base >= 4.6,+        base >= 4.10,         base < 5,+        bytestring,         ghc-prim,         containers,         transformers >= 0.3,@@ -79,10 +80,11 @@         NumInstances,         filepath,         directory,-        wl-pprint >= 1.2.1,-        csound-expression-dynamic >= 0.3.8,+        wl-pprint-text >= 1.2.0,+        csound-expression-dynamic >= 0.3.9.1,         temporal-media >= 0.6.3,-        hashable+        hashable,+        text   Hs-Source-Dirs:      src/   Exposed-Modules:     Csound.Typed@@ -99,12 +101,12 @@     Csound.Typed.Types.Tuple     Csound.Typed.Types.Lift     Csound.Typed.Types.Array+    Csound.Typed.Types.PureArray     Csound.Typed.Types.MonoArg     Csound.Typed.Types.SigSpace      Csound.Typed.Plugins -  Other-Modules:     Csound.Typed.GlobalState     Csound.Typed.GlobalState.Options     Csound.Typed.GlobalState.GE@@ -163,4 +165,8 @@    Default-Language: Haskell2010   Default-extensions:+    ImportQualifiedPost     LambdaCase+    OverloadedStrings+    ScopedTypeVariables+    TypeApplications

@@ -1,3 +1,4 @@+{-# Language ScopedTypeVariables #-} module Csound.Typed.Control (     -- * SE     module Csound.Typed.GlobalState.SE,@@ -25,12 +26,13 @@     module Csound.Typed.Control.Vco,     -- * Imperative instruments     module Csound.Typed.Control.InstrRef,-    -- * Array folding and traversals    +    -- * Array folding and traversals     module Csound.Typed.Control.ArrayTraverse,     -- * Reads global config arguments from command line     module Csound.Typed.Control.MacrosArgs ) where +import Data.Proxy import Csound.Typed.GlobalState.SE import Csound.Typed.Control.Ref @@ -49,23 +51,14 @@ import Csound.Typed.Types import Csound.Typed.GlobalState -instr0 :: Tuple a => SE a -> SE a-instr0 a = return $ toTuple $ saveIns0 ins0Arity (tupleRates $ proxy a) ins0Exp+instr0 :: forall a. Tuple a => SE a -> SE a+instr0 a = return $ toTuple $ saveIns0 ins0Arity (tupleRates (Proxy :: Proxy a)) ins0Exp     where         ins0Exp = execGEinSE $ fmap fromTuple a--        ins0Arity = tupleArity $ proxy a--        proxy :: Tuple a => SE a -> a-        proxy = const (toTuple $ return $ repeat undefined)--getIns :: Sigs a => SE a-getIns = res-    where -        res = fmap toTuple $ fromDep $ getIn (tupleArity $ proxy res) +        ins0Arity = tupleArity (Proxy :: Proxy a) -        proxy :: SE a -> a-        proxy = const undefined+getIns :: forall a. Sigs a => SE a+getIns = fmap toTuple $ fromDep $ getIn (tupleArity (Proxy :: Proxy a))  -- | Sets the global duration of the file or output signal to the given value. -- It should be used only once! The proper place is in the top-most@@ -79,4 +72,4 @@  -- | Gets new id. freshId :: SE D-freshId = SE $ fmap fromE freeChn +freshId = SE $ fmap fromE freeChn

@@ -14,6 +14,7 @@ import Csound.Typed.GlobalState import Csound.Typed.GlobalState.Opcodes(eventi, Event(..), downsamp) import Csound.Typed.InnerOpcodes+import Data.Text (Text)  import Csound.Typed.Plugins.TabQueue @@ -23,7 +24,7 @@ -- With Csound API we can send messages -- -- > i "name" time duration arg1 arg2 arg3-trigByName_ :: Arg a => String -> (a -> SE ()) -> SE ()+trigByName_ :: Arg a => Text -> (a -> SE ()) -> SE () trigByName_ name instr = geToSe $ saveNamedInstr name =<< (execSE $ instr toArg)  -- | Creates an instrument that can be triggered by name with Csound API.@@ -33,7 +34,7 @@ -- @p1@ is the name of teh instrument, @p2@ is the start time of the note, -- @p3@ is the duration of the note. Then @p4@ and @p5@ are going to be doubles and @p6@ -- is an integer that denotes a functional table.-trigByName  :: (Arg a, Sigs b) => String -> (a -> SE b) -> SE b+trigByName  :: (Arg a, Sigs b) => Text -> (a -> SE b) -> SE b trigByName name instr = do     ref <- newClearableGlobalRef 0     trigByName_ name (go ref)@@ -43,7 +44,7 @@  -- | It behaves just like the function @trigByNameMidi@. Only it doesn't produce an audio -- signal. It performs some procedure on note on and stops doing the precedure on note off.-trigByNameMidi_ :: forall a . Arg a => String -> ((D, D, a) -> SE ()) -> SE ()+trigByNameMidi_ :: forall a . Arg a => Text -> ((D, D, a) -> SE ()) -> SE () trigByNameMidi_ name instr = do     instrId <- geToSe $ saveInstr (instr toArg)     trigByName_ name (go instrId)@@ -55,10 +56,10 @@             noteFlagExpr <- toGE noteFlag             args <- fromTuple (pch, vol, other)             return $ do-                    D.when1 D.Ir (noteFlagExpr ==* 1) $ do-                        eventi (Event instrIdExpr 0 (-1) args)-                    D.when1 D.Ir (noteFlagExpr ==* 0) $ do-                        eventi (Event (negate instrIdExpr) 0 0 args)+                    D.when1 D.IfIr (noteFlagExpr ==* 1) $ do+                        D.toBlock $ eventi (Event instrIdExpr 0 (-1) args)+                    D.when1 D.IfIr (noteFlagExpr ==* 0) $ do+                        D.toBlock $ eventi (Event (negate instrIdExpr) 0 0 args)                     turnoff  -- | Creates an instrument that can be triggered by name with Csound API.@@ -87,14 +88,14 @@ -- Csound procedure invokes: -- -- > turnoff 18.pitchKey-trigByNameMidi  :: (Arg a, Sigs b) => String -> ((D, D, a) -> SE b) -> SE b+trigByNameMidi  :: (Arg a, Sigs b) => Text -> ((D, D, a) -> SE b) -> SE b trigByNameMidi name instr = do     ref <- newClearableGlobalRef 0     trigByNameMidi_ name (go ref)     readRef ref     where go ref x = mixRef ref =<< instr x -namedMonoMsg :: String -> SE MonoArg+namedMonoMsg :: Text -> SE MonoArg namedMonoMsg name = do     refPch <- newGlobalRef 0     refVol <- newGlobalRef 0@@ -118,7 +119,7 @@         onNote = tabQueue2_append         offNote tab (pch, _vol) = tabQueue2_delete tab pch -trigByNameMidiCbk :: String -> ((D, D) -> SE ())  -> ((D, D) -> SE ()) -> SE ()+trigByNameMidiCbk :: Text -> ((D, D) -> SE ())  -> ((D, D) -> SE ()) -> SE () trigByNameMidiCbk name noteOn noteOff =     trigByName_ name go     where

@@ -5,6 +5,7 @@     foldArr, foldRowArr, foldColumnArr, foldRowsArrD, foldColumnsArrD ) where +import Data.Proxy import Csound.Typed.Types import Csound.Typed.Control.Ref import Csound.Typed.GlobalState@@ -56,10 +57,7 @@                  fromDep_ D.whileEnd -        arity = tupleArity $ proxy array--        proxy :: Arr ix a -> ix-        proxy = const undefined+        arity = tupleArity (Proxy :: Proxy ix)          concatRefs :: [Ref b] -> Ref ix         concatRefs vs = Ref $ vs >>= \(Ref xs) -> xs

@@ -1,3 +1,4 @@+{-# Language ScopedTypeVariables #-} -- | Converts to low-level instruments module Csound.Typed.Control.Instr(     Arity(..), InsExp, EffExp,@@ -6,19 +7,15 @@     apInstr, apInstr0 ) where +import Data.Proxy import Csound.Dynamic(InstrId(..)) import qualified Csound.Typed.GlobalState.Elements as C  import Csound.Typed.Types import Csound.Typed.GlobalState -funProxy :: (a -> f b) -> (a, b)-funProxy = const (msg, msg)-    where msg = error "I'm a Csound.Typed.Control.Instr.funProxy"--funArity :: (Tuple a, Tuple b) => (a -> SE b) -> Arity-funArity instr = Arity (tupleArity a) (tupleArity b)-    where (a, b) = funProxy instr+funArity :: forall a b. (Tuple a, Tuple b) => (a -> SE b) -> Arity+funArity _instr = Arity (tupleArity (Proxy :: Proxy a)) (tupleArity (Proxy :: Proxy b))  constArity :: (Tuple a) => SE a -> Arity constArity a = Arity 0 (outArity a)@@ -38,13 +35,12 @@ unitExp :: SE Unit -> UnitExp unitExp = execGEinSE . fmap unUnit -apInstr :: (Arg a, Sigs b) => GE InstrId -> a -> b-apInstr instrIdGE args = res-    where-        res = toTuple $ do-            instrId <- instrIdGE-            argList <- fromTuple args-            return $ C.subinstr (tupleArity res) instrId argList+apInstr :: forall a b. (Arg a, Sigs b) => GE InstrId -> a -> b+apInstr instrIdGE args =+  toTuple $ do+    instrId <- instrIdGE+    argList <- fromTuple args+    return $ C.subinstr (tupleArity (Proxy :: Proxy b)) instrId argList  apInstr0 :: (Sigs b) => GE InstrId -> b apInstr0 instrId = apInstr instrId unit

@@ -5,12 +5,13 @@  import Csound.Typed.Types import qualified Csound.Typed.GlobalState as G(readMacrosString, readMacrosDouble, readMacrosInt)+import Data.Text (Text) -readMacrosString :: String -> String -> Str+readMacrosString :: Text -> Text -> Str readMacrosString name value = fromGE $ G.readMacrosString name value -readMacrosDouble :: String -> Double -> D+readMacrosDouble :: Text -> Double -> D readMacrosDouble name value = fromGE $ G.readMacrosDouble name value -readMacrosInt :: String -> Int -> D+readMacrosInt :: Text -> Int -> D readMacrosInt name value = fromGE $ G.readMacrosInt  name value

@@ -13,6 +13,7 @@     Sco, CsdEventList, CsdEvent ) where +import Data.Proxy import Data.Boolean  import Control.Monad.IO.Class@@ -158,17 +159,11 @@ toEventList :: Sco (Mix a) -> GE (CsdEventList M) toEventList evts = fmap delayAndRescaleCsdEventListM $ traverse unMix $ evts -mixArity :: Sigs b => f (Mix b) -> Int-mixArity = tupleArity . proxy-    where-        proxy :: f (Mix b) -> b-        proxy = const undefined+mixArity :: forall b f. Sigs b => f (Mix b) -> Int+mixArity _ = tupleArity (Proxy :: Proxy b) -mixArityFun :: Sigs b => (a -> f (Mix b)) -> Int-mixArityFun = tupleArity . proxy-    where-        proxy :: (a -> f (Mix b)) -> b-        proxy = const undefined+mixArityFun :: forall a b f. Sigs b => (a -> f (Mix b)) -> Int+mixArityFun _ = tupleArity (Proxy :: Proxy b)  ----------------------------------------------------------- -- instances

@@ -9,6 +9,7 @@ ) where  import Data.Boolean+import Data.Proxy  import Control.Monad import Control.Monad.Trans.Class@@ -42,19 +43,18 @@  -- | Allocates a new local (it is visible within the instrument) mutable value and initializes it with value. -- A reference can contain a tuple of variables.-newRef :: Tuple a => a -> SE (Ref a)-newRef t = fmap Ref $ newLocalVars (tupleRates t) (fromTuple t)+newRef :: forall a. Tuple a => a -> SE (Ref a)+newRef t = fmap Ref $ newLocalVars (tupleRates (Proxy :: Proxy a)) (fromTuple t)  -- | Allocates a new local (it is visible within the instrument) mutable value and initializes it with value. -- A reference can contain a tuple of variables. -- It contains control signals (k-rate) and constants for numbers (i-rates).-newCtrlRef :: Tuple a => a -> SE (Ref a)-newCtrlRef t = fmap Ref $ newLocalVars (fmap toCtrlRate $ tupleRates t) (fromTuple t)+newCtrlRef :: forall a. Tuple a => a -> SE (Ref a)+newCtrlRef t = fmap Ref $ newLocalVars (fmap toCtrlRate $ tupleRates (Proxy :: Proxy a)) (fromTuple t)  toCtrlRate :: Rate -> Rate toCtrlRate x = case x of     Ar -> Kr-    Kr -> Ir     _  -> x  concatRef :: (Tuple a, Tuple b) => Ref a -> Ref b -> Ref (a, b)@@ -85,19 +85,19 @@ -- to mutable value but a pair of reader and writer functions. sensorsSE :: Tuple a => a -> SE (SE a, a -> SE ()) sensorsSE a = do-    ref <- newRef a+    ref <- newCtrlRef a     return $ (readRef ref, writeRef ref)  -- | Allocates a new global mutable value and initializes it with value. -- A reference can contain a tuple of variables.-newGlobalRef :: Tuple a => a -> SE (Ref a)-newGlobalRef t = fmap Ref $ newGlobalVars (tupleRates t) (fromTuple t)+newGlobalRef :: forall a. Tuple a => a -> SE (Ref a)+newGlobalRef t = fmap Ref $ newGlobalVars (tupleRates (Proxy :: Proxy a)) (fromTuple t)  -- | Allocates a new global mutable value and initializes it with value. -- A reference can contain a tuple of variables. -- It contains control signals (k-rate) and constants for numbers (i-rates).-newGlobalCtrlRef :: Tuple a => a -> SE (Ref a)-newGlobalCtrlRef t = fmap Ref $ newGlobalVars (fmap toCtrlRate $ tupleRates t) (fromTuple t)+newGlobalCtrlRef :: forall a . Tuple a => a -> SE (Ref a)+newGlobalCtrlRef t = fmap Ref $ newGlobalVars (fmap toCtrlRate $ tupleRates (Proxy :: Proxy a)) (fromTuple t)  -- | An alias for the function @newRef@. It returns not the reference -- to mutable value but a pair of reader and writer functions.@@ -110,8 +110,8 @@ -- A reference can contain a tuple of variables. -- The variable is set to zero at the end of every iteration. -- It's useful for accumulation of audio values from several instruments.-newClearableGlobalRef :: Tuple a => a -> SE (Ref a)-newClearableGlobalRef t = fmap Ref $ newClearableGlobalVars (tupleRates t) (fromTuple t)+newClearableGlobalRef :: forall a . Tuple a => a -> SE (Ref a)+newClearableGlobalRef t = fmap Ref $ newClearableGlobalVars (tupleRates (Proxy :: Proxy a)) (fromTuple t)  ------------------------------------------------------------------------------- -- writable tables

@@ -5,6 +5,7 @@  import Data.Boolean import Data.Default+import Data.Text (Text)  import qualified Csound.Dynamic as D @@ -13,12 +14,12 @@  -- | The sf2 sound font preset. It is defined with -- file name, bank and program integers.-data Sf = Sf -    { sfName :: String+data Sf = Sf+    { sfName :: Text     , sfBank :: Int-    , sfProg :: Int } +    , sfProg :: Int }     | SfId (GE E)-    + instance Val Sf where     fromGE = SfId     toGE   = unSf@@ -28,9 +29,9 @@     SfId a -> a     Sf name bank prog -> fmap D.int $ saveSf (SfSpec name bank prog) -instance Default Sf where +instance Default Sf where     def = fromE 0  type instance BooleanOf Sf  = BoolD-instance IfB Sf where ifB = on3 ifB+instance IfB Sf where ifB = on3 (D.ifExp D.IfIr) 

@@ -49,12 +49,12 @@ ) where  import Data.List-import Data.Hashable+import Data.ByteString (ByteString)  import Control.Monad.Trans.State.Strict import Control.Monad(zipWithM_) import Data.Default-import qualified Data.Map as M+import qualified Data.Map.Strict as M import qualified Data.IntMap as IM  import Csound.Dynamic.Types hiding (genId)@@ -62,6 +62,8 @@ import Csound.Dynamic.Build.Numeric()  import Csound.Typed.GlobalState.Opcodes+import Data.Text (Text)+import Data.Text qualified as Text  -- tables of identifiers @@ -156,9 +158,9 @@  -- strings -type StringMap = IdMap String+type StringMap = IdMap Text -newString :: String -> State StringMap Prim+newString :: Text -> State StringMap Prim newString = fmap PrimInt . saveId  -- gen counter@@ -173,7 +175,7 @@     , sfVars :: [Var] }  data SfSpec = SfSpec-    { sfName    :: String+    { sfName    :: Text     , sfBank    :: Int     , sfProgram :: Int     } deriving (Eq, Ord, Show)@@ -186,22 +188,24 @@ sfVar :: Int -> E sfVar n = readOnlyVar (VarVerbatim Ir $ sfEngineName n) -sfEngineName :: Int -> String-sfEngineName n = "gi_Sf_engine_" ++ show n+sfEngineName :: Int -> Text+sfEngineName n = "gi_Sf_engine_" <> Text.pack (show n) -sfInstrName :: Int -> String-sfInstrName n = "i_Sf_instr_" ++ show n+sfInstrName :: Int -> Text+sfInstrName n = "i_Sf_instr_" <> Text.pack (show n)  renderSf :: Monad m => SfSpec -> Int -> DepT m () renderSf (SfSpec name bank prog) n = verbatim $-    engineStr ++ "\n" ++-    loadStr   ++ "\n" ++-    selectProgStr ++ "\n"+  Text.unlines+    [ engineStr+    , loadStr+    , selectProgStr+    ]     where-        engineStr = engineName ++ " fluidEngine"-        loadStr   = insName ++ " fluidLoad \"" ++ name ++ "\", " ++  engineName ++ ", 1"-        selectProgStr = "fluidProgramSelect " ++ engineName ++ ", 1, " ++ insName-            ++ ", " ++ show bank ++ ", " ++ show prog+        engineStr = engineName <> " fluidEngine"+        loadStr   = insName <> " fluidLoad \"" <> name <> "\", " <>  engineName <> ", 1"+        selectProgStr = "fluidProgramSelect " <> engineName <> ", 1, " <> insName+            <> ", " <> Text.pack (show bank) <> ", " <> Text.pack (show prog)          engineName = sfEngineName n         insName    = sfInstrName n@@ -220,7 +224,7 @@     UserBandLimitedWave   userId   -> noRate $ ReadVar $ bandLimitedVar userId  bandLimitedVar :: Show a => a -> Var-bandLimitedVar userId = Var GlobalVar Ir ("BandLim" ++ show userId)+bandLimitedVar userId = Var GlobalVar Ir ("BandLim" <> Text.pack (show userId))  data BandLimitedMap = BandLimitedMap     { simpleBandLimitedMap :: M.Map BandLimited BandLimitedId@@ -271,7 +275,7 @@             renderVcoVarAssignment genId          freeVcoVar = Var GlobalVar Ir "free_vco"-        ftVar n = Var GlobalVar Ir $ "vco_table_" ++ show n+        ftVar n = Var GlobalVar Ir $ "vco_table_" <> Text.pack (show n)          renderFtgen lastGenId (g, n) = writeVar (ftVar n) $ ftgen (int $ lastGenId + n) g @@ -343,13 +347,13 @@ bpmVar :: Var bpmVar = Var GlobalVar Kr bpmVarName -bpmVarName :: String+bpmVarName :: Text bpmVarName = "gBpmVar"  newGlobalVar :: GlobalVarType -> Rate -> E -> State Globals Var newGlobalVar ty rate initVal = state $ \s ->     let newId = globalsNewId s-        var   = Var GlobalVar rate ('g' : show newId)+        var   = Var GlobalVar rate (Text.cons 'g' (Text.pack $ show newId))         s1    = s { globalsNewId = succ newId                   , globalsVars  = AllocVar ty var initVal : globalsVars s }     in  (var, s1)@@ -363,7 +367,7 @@ newPersistentGloabalArrVar :: Rate -> [E] -> State Globals Var newPersistentGloabalArrVar rate sizes = state $ \s ->     let newId = globalsNewId s-        var   = Var GlobalVar rate ('g' : show newId)+        var   = Var GlobalVar rate (Text.cons 'g' (Text.pack $ show newId))         s1    = s { globalsNewId = succ newId                   , globalsVars  = AllocArrVar var sizes : globalsVars s }     in (var, s1)@@ -392,13 +396,13 @@ -- instrs  data Instrs = Instrs-    { instrsCache   :: IM.IntMap InstrId+    { instrsCache   :: M.Map ByteString InstrId     , instrsNewId   :: Int     , instrsContent :: [(InstrId, InstrBody)]     }  instance Default Instrs where-    def = Instrs IM.empty 18 []+    def = Instrs M.empty 18 []  getInstrIds :: Instrs -> [InstrId] getInstrIds = fmap fst . instrsContent@@ -406,58 +410,27 @@ ----------------------------------------------------------------- -- - saveInstr :: InstrBody -> State Instrs InstrId saveInstr body = state $ \s ->-    let h = hash body-    in  case IM.lookup h $ instrsCache s of+    let h = hashE body+    in  case M.lookup h $ instrsCache s of             Just  n -> (n, s)             Nothing ->                 let newId = instrsNewId s-                    s1    = s { instrsCache   = IM.insert h (intInstrId newId) $ instrsCache s+                    s1    = s { instrsCache   = M.insert h (intInstrId newId) $ instrsCache s                               , instrsNewId   = succ newId                               , instrsContent = (intInstrId newId, body) : instrsContent s }                 in  (intInstrId newId, s1) -{--saveCachedInstr :: InstrBody -> State Instrs InstrId-saveCachedInstr name body = state $ \s ->-    case IM.lookup name $ instrsCache s of-        Just n  -> (n, s)-        Nothing ->-            let newId   = instrsNewId s-                s1      = s { instrsCache   = IM.insert name (intInstrId newId) $ instrsCache s-                            , instrsNewId   = succ newId-                            , instrsContent = (intInstrId newId, body) : instrsContent s }-            in  (intInstrId newId, s1)--newInstrId :: State Instrs InstrId-newInstrId = state $ \s ->-    let newId   = instrsNewId s-        s1      = s { instrsNewId = succ newId }-    in  (intInstrId newId, s1)--saveInstrById :: InstrId -> InstrBody -> State Instrs ()-saveInstrById instrId body = state $ \s ->-    let s1 = s { instrsContent = (instrId, body) : instrsContent s }-    in  ((), s1)--saveInstr :: InstrBody -> State Instrs InstrId-saveInstr body = do-    newId <- newInstrId-    saveInstrById newId body-    return newId--}- ----------------------------------------------------------------- -- named instrs -newtype NamedInstrs = NamedInstrs { unNamedInstrs :: [(String, InstrBody)] }+newtype NamedInstrs = NamedInstrs { unNamedInstrs :: [(Text, InstrBody)] }  instance Default NamedInstrs where     def = NamedInstrs [] -saveNamedInstr :: String -> InstrBody -> State NamedInstrs ()+saveNamedInstr :: Text -> InstrBody -> State NamedInstrs () saveNamedInstr name body = state $ \(NamedInstrs xs) -> ((), NamedInstrs $ (name, body) : xs)  -----------------------------------------------------------------@@ -528,12 +501,12 @@ ---------------------------------------------------------- -- macros arguments -type MacrosInits = M.Map String MacrosInit+type MacrosInits = M.Map Text MacrosInit  data MacrosInit-    = MacrosInitDouble { macrosInitName :: String, macrosInitValueDouble :: Double }-    | MacrosInitString { macrosInitName :: String, macrosInitValueString :: String }-    | MacrosInitInt    { macrosInitName :: String, macrosInitValueInt    :: Int  }+    = MacrosInitDouble { macrosInitName :: Text, macrosInitValueDouble :: Double }+    | MacrosInitString { macrosInitName :: Text, macrosInitValueString :: Text }+    | MacrosInitInt    { macrosInitName :: Text, macrosInitValueInt    :: Int  }     deriving (Show, Eq, Ord)  initMacros :: MacrosInit -> State MacrosInits ()@@ -542,12 +515,12 @@ -------------------------------------------------------- -- Udo plugins -newtype UdoPlugin  = UdoPlugin { unUdoPlugin :: String }+newtype UdoPlugin  = UdoPlugin { unUdoPlugin :: Text }  addUdoPlugin :: UdoPlugin -> State [UdoPlugin] () addUdoPlugin a = modify (a :) -getUdoPluginNames :: [UdoPlugin] -> [String]+getUdoPluginNames :: [UdoPlugin] -> [Text] getUdoPluginNames xs = nub (fmap unUdoPlugin xs)  -- tabQueue

@@ -52,6 +52,8 @@ import Control.Monad import Data.Boolean import Data.Default+import Data.Text (Text)+import Data.Text qualified as Text import qualified Data.IntMap as IM import qualified Data.Map    as M @@ -93,39 +95,39 @@     fmap f = GE . fmap f . unGE  instance Applicative GE where-    pure = return+    pure = GE . return     (<*>) = ap  instance Monad GE where-    return = GE . return     ma >>= mf = GE $ unGE ma >>= unGE . mf  instance MonadIO GE where     liftIO = GE . liftIO . liftIO  data History = History-    { genMap            :: GenMap-    , writeGenMap       :: WriteGenMap-    , globalGenCounter  :: Int-    , stringMap         :: StringMap-    , sfMap             :: SfMap-    , midiMap           :: MidiMap GE-    , globals           :: Globals-    , instrs            :: Instrs-    , udoPlugins        :: [UdoPlugin]-    , namedInstrs       :: NamedInstrs-    , midis             :: [MidiAssign]-    , midiCtrls         :: [MidiCtrl]-    , totalDur          :: Maybe TotalDur-    , alwaysOnInstrs    :: [InstrId]-    , notes             :: [(InstrId, CsdEvent)]-    , userInstr0        :: Dep ()-    , bandLimitedMap    :: BandLimitedMap-    , cache             :: Cache GE-    , guis              :: Guis-    , oscListenPorts    :: OscListenPorts-    , cabbageGui        :: Maybe Cabbage.Lang-    , macrosInits       :: MacrosInits }+    { genMap            :: !GenMap+    , writeGenMap       :: !WriteGenMap+    , globalGenCounter  :: !Int+    , stringMap         :: !StringMap+    , sfMap             :: !SfMap+    , midiMap           :: !(MidiMap GE)+    , globals           :: !Globals+    , instrs            :: !Instrs+    , udoPlugins        :: ![UdoPlugin]+    , namedInstrs       :: !NamedInstrs+    , midis             :: ![MidiAssign]+    , midiCtrls         :: ![MidiCtrl]+    , totalDur          :: !(Maybe TotalDur)+    , alwaysOnInstrs    :: ![InstrId]+    , notes             :: ![(InstrId, CsdEvent)]+    , userInstr0        :: !(Dep ())+    , bandLimitedMap    :: !BandLimitedMap+    , cache             :: !(Cache GE)+    , guis              :: !Guis+    , oscListenPorts    :: !OscListenPorts+    , cabbageGui        :: !(Maybe Cabbage.Lang)+    , macrosInits       :: !MacrosInits+    }  instance Default History where     def = History def def def def def def def def def def def def def def def (return ()) def def def def def def@@ -175,7 +177,7 @@ setDurationForce :: E -> GE () setDurationForce = setTotalDur . ExpDur -saveStr :: String -> GE E+saveStr :: Text -> GE E saveStr = fmap prim . onStringMap . newString     where onStringMap = onHistory stringMap (\val h -> h{ stringMap = val }) @@ -300,7 +302,7 @@ ---------------------------------------------------------------------- -- named instruments -saveNamedInstr :: String -> InstrBody -> GE ()+saveNamedInstr :: Text -> InstrBody -> GE () saveNamedInstr name body = onNamedInstrs $ E.saveNamedInstr name body     where onNamedInstrs = onHistory namedInstrs (\a h -> h { namedInstrs = a }) @@ -354,7 +356,7 @@     in  (GuiHandle n, h{ guis = g' })  guiHandleToVar :: GuiHandle -> Var-guiHandleToVar (GuiHandle n) = Var GlobalVar Ir ('h' : show n)+guiHandleToVar (GuiHandle n) = Var GlobalVar Ir (Text.cons 'h' $ Text.pack $ show n)  newGuiVar :: GE (Var, GuiHandle) newGuiVar = liftA2 (,) (onGlobals $ newPersistentGlobalVar Kr 0) newGuiHandle@@ -507,12 +509,12 @@ keyEventInstrBody keyMap = execDepT $ do     let keys     = flKeyIn         isChange = changed keys ==* 1-    when1 Kr isChange $ do-        whens Kr (fmap (uncurry $ listenEvt keys) events) doNothing+    when1 IfKr isChange $ do+        toBlock $ whens IfKr (fmap (uncurry $ listenEvt keys) events) (toBlock doNothing)     where         doNothing = return () -        listenEvt keySig keyCode var = (keySig ==* int keyCode, writeVar var 1)+        listenEvt keySig keyCode var = (keySig ==* int keyCode, toBlock $ writeVar var 1)          events = IM.toList keyMap @@ -569,16 +571,16 @@ ----------------------------------------------- -- read macros -readMacrosDouble :: String -> Double -> GE E+readMacrosDouble :: Text -> Double -> GE E readMacrosDouble = readMacrosBy D.readMacrosDouble MacrosInitDouble -readMacrosString :: String -> String -> GE E+readMacrosString :: Text -> Text -> GE E readMacrosString = readMacrosBy D.readMacrosString MacrosInitString -readMacrosInt :: String -> Int -> GE E+readMacrosInt :: Text -> Int -> GE E readMacrosInt    = readMacrosBy D.readMacrosInt    MacrosInitInt -readMacrosBy :: (String ->  E) -> (String -> a -> MacrosInit) -> String -> a -> GE E+readMacrosBy :: (Text ->  E) -> (Text -> a -> MacrosInit) -> Text -> a -> GE E readMacrosBy extract allocator name initValue = do     onMacrosInits $ initMacros $ allocator name initValue     return $ extract name@@ -591,13 +593,9 @@ addUdoPlugin p = onUdo (E.addUdoPlugin p)     where onUdo = onHistory udoPlugins (\val h -> h{ udoPlugins = val }) -renderUdoPlugins :: History -> IO String-renderUdoPlugins h = fmap concat $ mapM getUdoPluginBody $ getUdoPluginNames $ udoPlugins h--getUdoPluginBody :: String -> IO String-getUdoPluginBody name = readFile =<< getDataFileName filename-    where filename = concat ["data/opcodes/", name, ".udo"]---+renderUdoPlugins :: History -> IO Text+renderUdoPlugins h = fmap mconcat $ mapM getUdoPluginBody $ getUdoPluginNames $ udoPlugins h +getUdoPluginBody :: Text -> IO Text+getUdoPluginBody name = fmap Text.pack $ readFile =<< getDataFileName filename+    where filename = concat ["data/opcodes/", Text.unpack name, ".udo"]

@@ -37,11 +37,14 @@     downsamp ) where +import Control.Monad import Prelude hiding ((<*)) import Control.Monad(zipWithM_, forM_) import Data.Boolean  import Csound.Dynamic+import Data.Text (Text)+import Data.Text qualified as Text  -- channels @@ -88,8 +91,8 @@ servantUpdateChnAlive pargId = do     let sName = chnAliveName (pn pargId)     kAlive <- chngetK sName-    when1 Kr (kAlive <* -10) $ do-        turnoff+    when1 IfKr (kAlive <* -10) $ do+        toBlock turnoff     chnsetK sName (kAlive - 1)  getRetrigVal :: Int -> E@@ -100,14 +103,14 @@     let sName = chnRetrigName (pn pargId)     let retrigVal = pn $ pargId + 1     kRetrig <- chngetK sName-    when1 Kr (kRetrig /=* retrigVal) $ do-        turnoff+    when1 IfKr (kRetrig /=* retrigVal) $ do+        toBlock turnoff  servantUpdateChnEvtLoop :: Monad m => Int -> DepT m () servantUpdateChnEvtLoop pargId = do     let sName = chnEvtLoopName (pn pargId)     kEvtLoop <- chngetK sName-    chnsetK sName (ifB (kEvtLoop ==* 0) 1 0)+    chnsetK sName (ifExp IfKr (kEvtLoop ==* 0) 1 0)     turnoff  readChnEvtLoop :: Monad m => ChnRef -> DepT m E@@ -151,15 +154,15 @@ chnclear name = depT_ $ opcs "chnclear" [(Xr, [Sr])] [name]  chnUpdateUdo :: Monad m => DepT m ()-chnUpdateUdo = verbatim $ unlines [+chnUpdateUdo = verbatim $ Text.unlines [     "giPort init 1",-    "opcode " ++ chnUpdateOpcodeName ++ ", i, 0",+    "opcode " <> chnUpdateOpcodeName <> ", i, 0",     "xout giPort",     "giPort = giPort + 1",     "endop"]  -chnUpdateOpcodeName :: String+chnUpdateOpcodeName :: Text chnUpdateOpcodeName = "FreePort"  freeChn :: Monad m => DepT m E@@ -185,7 +188,7 @@ event_i :: Monad m => Event -> DepT m () event_i = eventBy "event_i" Ir -eventBy :: Monad m => String -> Rate -> Event -> DepT m ()+eventBy :: Monad m => Text -> Rate -> Event -> DepT m () eventBy name rate a = depT_ $ opcs name [(Xr, Sr : repeat rate)]     (str "i" : (eventInstrId a) : (eventStart a) : (eventDur a) : (eventArgs a)) @@ -231,8 +234,8 @@ autoOff :: Monad m => E -> [E] -> DepT m [E] autoOff dt a = do     ihold-    when1 Kr (trig a)-        turnoff+    when1 IfKr (trig a) $+        toBlock turnoff     return a     where         trig = (<* eps) . (env + ) . setRate Kr . flip follow dt . l2@@ -300,13 +303,13 @@ ftgen :: E -> Gen -> E ftgen n g = opcs "ftgen" [(Ir, repeat Ir)]     $ [n, 0, int $ genSize g, genIdE $ genId g]-    ++ (maybe [] (return . str) $ genFile g)+    ++ (maybe [] (return . prim . PrimString) $ genFile g)     ++ (fmap double $ genArgs g)  genIdE :: GenId -> E genIdE = \case     IntGenId n -> int n-    StringGenId a -> str a+    StringGenId a -> prim (PrimString a)  vco2init :: [E] -> E vco2init = opcs "vco2init" [(Ir, repeat Ir)]@@ -368,8 +371,8 @@ ----------------------------------------------------------- -- soundfonts -sfload :: Monad m => String -> DepT m E-sfload fileName =  depT $ opcs "sfload" [(Ir, [Sr])] [str fileName]+sfload :: Monad m => Text -> DepT m E+sfload fileName =  depT $ opcs "sfload" [(Ir, [Sr])] [prim $ PrimString fileName]  sfplist :: Monad m => E -> DepT m () sfplist sf = depT_ $ opcs "sfplist" [(Xr, [Ir])] [sf]@@ -377,7 +380,7 @@ sfpreset :: Monad m => Int -> Int -> E -> Int -> DepT m () sfpreset bank prog sf index = depT_ $ opcs "iPreset sfpreset" [(Xr, [Ir, Ir, Ir, Ir])] [int prog, int bank, sf, int index] -sfSetList :: Monad m => String -> [(Int, Int, Int)] -> DepT m ()+sfSetList :: Monad m => Text -> [(Int, Int, Int)] -> DepT m () sfSetList fileName presets = do     sf <- sfload fileName     sfplist sf@@ -389,7 +392,7 @@ -- if we use the scaling at I-rate we don't need to use portamento. -- If we want to scale with signal the portamento is must midiVolumeFactor :: E -> E-midiVolumeFactor idx = ifB (n <* 2) 1 (recip sqrtN)+midiVolumeFactor idx = ifExp IfIr (n <* 2) 1 (recip sqrtN)     where sqrtN = sqrt n           n     = activeIr idx 

@@ -28,6 +28,8 @@  import qualified Data.IntMap as IM import qualified Data.Map    as M+import Data.Text (Text)+import Data.Text qualified as Text  import Csound.Dynamic hiding (csdFlags) @@ -48,12 +50,13 @@     , csdTabFi          :: Maybe TabFi              -- ^ Default fidelity of the arrays     , csdScaleUI        :: Maybe (Double, Double)   -- ^ Scale factors for UI-window     , csdJacko          :: Maybe Jacko-    , csdJackConnect    :: Maybe [(String, String)] -- ^ list of jack connections to make after csound app is launched (Linux only)+    , csdJackConnect    :: Maybe [(Text, Text)] -- ^ list of jack connections to make after csound app is launched (Linux only)     , csdTrace          :: Maybe Bool               -- ^ Do we need debug-trace, default is False+    , csdRender         :: Maybe RenderOptions     } deriving (Eq, Show, Read)  instance Default Options where-    def = Options def def def def def def def def def+    def = Options def def def def def def def def def def  #if MIN_VERSION_base(4,11,0) instance Semigroup Options where@@ -80,7 +83,9 @@     , csdScaleUI        = csdScaleUI a <|> csdScaleUI b     , csdJacko          = csdJacko a <|> csdJacko b     , csdJackConnect    = mappend (csdJackConnect a) (csdJackConnect b)-    , csdTrace          = csdTrace a <|> csdTrace b }+    , csdTrace          = csdTrace a <|> csdTrace b+    , csdRender         = csdRender a <|> csdRender b+    }  defScaleUI :: Options -> (Double, Double) defScaleUI = maybe (1, 1) id . csdScaleUI@@ -101,7 +106,7 @@ data TabFi = TabFi     { tabFiBase   :: Int     , tabFiGens   :: IM.IntMap Int-    , tabNamedFiGens :: M.Map String Int+    , tabNamedFiGens :: M.Map Text Int     } deriving (Eq, Show, Read)  instance Default TabFi where@@ -122,7 +127,7 @@ --   given GEN-routine. -- -- with this function we can set lower table sizes for tables that are usually used in the envelopes.-fineFi :: Int -> [(Int, Int)] -> [(String, Int)] -> TabFi+fineFi :: Int -> [(Int, Int)] -> [(Text, Int)] -> TabFi fineFi n xs ys = TabFi n (IM.fromList xs) (M.fromList ys)  -- | Sets the same table size for all tables.@@ -193,7 +198,7 @@  -- Identifiers for named GEN-routines -idPadsynth, idTanh, idExp, idSone, idFarey, idWave :: String+idPadsynth, idTanh, idExp, idSone, idFarey, idWave :: Text  idPadsynth = "padsynth" @@ -206,7 +211,7 @@ ---------------------------------------------------------- -- Jacko -type JackoConnect = (String, String)+type JackoConnect = (Text, Text)  -- | Describes the Jacko header. All information that is going to be set in the global settings for Jacko opcodes. -- The jacko opcodes allows us to easily turn our app into Jack-client. We can also do it with command line flags.@@ -214,8 +219,8 @@ -- -- see the Csound docs for details: <http://csound.github.io/docs/manual/JackoOpcodes.html> data Jacko = Jacko-    { jackoClient       :: String-    , jackoServer       :: String+    { jackoClient       :: Text+    , jackoServer       :: Text     , jackoAudioIns     :: [JackoConnect]     , jackoAudioOuts    :: [JackoConnect]     , jackoMidiIns      :: [JackoConnect]@@ -235,9 +240,9 @@         , jackoFreewheel    = False         , jackoInfo         = False } -renderJacko :: Jacko -> String-renderJacko spec = unlines $ filter ( /= "")-    [ "JackoInit " ++ (show $ jackoServer spec) ++ ", " ++ (show $ jackoClient spec)+renderJacko :: Jacko -> Text+renderJacko spec = Text.unlines $ filter ( /= "")+    [ "JackoInit " <> (Text.pack $ show $ jackoServer spec) <> ", " <> (Text.pack $ show $ jackoClient spec)     , if (jackoFreewheel spec) then "JackoFreewheel 1" else ""     , if (jackoInfo spec) then "JackoInfo" else ""     , renderConnections "JackoAudioInConnect" $ jackoAudioIns spec@@ -246,9 +251,9 @@     , renderConnections "JackoMidiOutConnect" $ jackoMidiOuts spec     , "JackoOn" ]     where-        renderConnections name links = unlines $ fmap (renderLink name) links+        renderConnections name links = Text.unlines $ fmap (renderLink name) links -        renderLink name (a, b) = name ++ " " ++ (show a) ++ ", " ++  (show b)+        renderLink name (a, b) = name <> " " <> Text.pack (show a) <> ", " <> Text.pack (show b)   csdNeedTrace :: Options -> Bool

@@ -5,12 +5,13 @@ -- cn write a signal to the port or can read the singals. module Csound.Typed.GlobalState.Port(     IsPort(..), mixPort, modifyPort,-    Port(..), freePort, +    Port(..), freePort,     PortCtrl(..), freePortCtrl ) where  import Control.Monad import Control.Monad.Trans.Class+import Data.Proxy  import Csound.Dynamic @@ -19,11 +20,11 @@ import Csound.Typed.Types.Tuple import Csound.Typed.Types.Prim -import Csound.Typed.GlobalState.Opcodes(freeChn, chnName, chnget, chnset, chngetK, chnsetK)    +import Csound.Typed.GlobalState.Opcodes(freeChn, chnName, chnget, chnset, chngetK, chnsetK)  -- port class -class IsPort p where +class IsPort p where     readPort  :: Sigs a => p a -> SE a     writePort :: Sigs a => p a -> a -> SE () @@ -32,7 +33,7 @@  modifyPort :: (Sigs a, IsPort port) => port a -> (a -> a) -> SE () modifyPort p f = do-    value <- readPort p +    value <- readPort p     writePort p $ f value  -- port for audio signals@@ -46,7 +47,7 @@     tupleMethods = makeTupleMethods to from         where             to :: D -> Port a-            to =  Port . toGE +            to =  Port . toGE              from :: Port a -> D             from (Port e) = fromGE e@@ -61,10 +62,10 @@     writePort port a = SE $ do         (names, values) <- lift getNamesAndValues         zipWithM_ chnset names values-        where +        where             getNamesAndValues = do                 names  <- getNames port-                values <- fromTuple a            +                values <- fromTuple a                 return (names, values)  -------------------------------------------------------------@@ -79,7 +80,7 @@     tupleMethods = makeTupleMethods to from         where             to :: D -> PortCtrl a-            to =  PortCtrl . toGE +            to =  PortCtrl . toGE              from :: PortCtrl a -> D             from (PortCtrl e) = fromGE e@@ -94,10 +95,10 @@     writePort port a = SE $ do         (names, values) <- lift getNamesAndValues         zipWithM_ chnsetK names values-        where +        where             getNamesAndValues = do                 names  <- getNamesCtrl port-                values <- fromTuple a            +                values <- fromTuple a                 return (names, values)  -------------------------------------------------------@@ -105,9 +106,9 @@ getNames :: forall a . Sigs a => Port a -> GE [E] getNames (Port ref) = do     idx <- ref-    return $ fmap (flip chnName idx) [1 .. (tupleArity ((error "No def here") :: a))]+    return $ fmap (flip chnName idx) [1 .. (tupleArity (Proxy :: Proxy a))]  getNamesCtrl :: forall a . Sigs a => PortCtrl a -> GE [E] getNamesCtrl (PortCtrl ref) = do     idx <- ref-    return $ fmap (flip chnName idx) [1 .. (tupleArity ((error "No def here") :: a))]+    return $ fmap (flip chnName idx) [1 .. (tupleArity (Proxy :: Proxy a))]

@@ -23,11 +23,10 @@     fmap f = SE . fmap f . unSE  instance Applicative SE where-    pure = return+    pure = SE . return     (<*>) = ap  instance Monad SE where-    return = SE . return     ma >>= mf = SE $ unSE ma >>= unSE . mf  runSE :: SE a -> GE a

@@ -11,16 +11,16 @@ import Data.Default  data Interval = Interval-    { start :: Int-    , leng  :: Int+    { start :: !Int+    , leng  :: !Int     } deriving (Show)  -- | A rectangle. data Rect = Rect-    { px        :: Int-    , py        :: Int-    , width     :: Int-    , height    :: Int+    { px        :: !Int+    , py        :: !Int+    , width     :: !Int+    , height    :: !Int     } deriving (Show)  fromRect :: Rect -> (Interval, Interval)@@ -30,10 +30,10 @@ toRect a b = Rect (start a) (start b) (leng a) (leng b)  data AbsScene ctx a-    = Elem Rect a+    = Elem !Rect !a     | EmptyScene-    | Group [AbsScene ctx a]-    | Ctx Rect ctx (AbsScene ctx a)+    | Group ![AbsScene ctx a]+    | Ctx !Rect !ctx !(AbsScene ctx a)     deriving (Show)  @@ -71,11 +71,10 @@     deriving (Show, Functor)  instance Applicative (Scene ctx) where-    pure = return+    pure = Prim     (<*>) = ap  instance Monad (Scene ctx) where-    return = Prim     ma >>= mf = joinScene $ fmap mf ma         where             joinScene :: Scene ctx (Scene ctx a) -> Scene ctx a

@@ -20,6 +20,7 @@  import Data.Maybe import Control.Monad.Trans.Writer.Strict+import Data.Text (Text)  import Csound.Typed.Gui.Cabbage.CabbageLang @@ -43,7 +44,7 @@ --------------------------------------- -- widgets -widget :: String -> CabProp -> Cab+widget :: Text -> CabProp -> Cab widget name props = Cab' $ tell [Line name $ runCabProp props]  ---------------------------------------@@ -79,10 +80,10 @@ --------------------------------------- -- properties -mkProperty :: String -> [Arg] -> CabProp+mkProperty :: Text -> [Arg] -> CabProp mkProperty name args = CabProp' $ tell [Property name args] -data Col = Hash String | Rgb Int Int Int+data Col = Hash Text | Rgb Int Int Int  colProp :: Col -> [Arg] colProp x = case x of@@ -95,13 +96,13 @@ bounds :: Int -> Int -> Int -> Int -> CabProp bounds x y w h = mkProperty "bounds" (fmap IntArg [x, y, w, h]) -channel :: String -> CabProp+channel :: Text -> CabProp channel name = mkProperty "channel" [StringArg name] -text1 :: String -> CabProp+text1 :: Text -> CabProp text1 name = mkProperty "text" [StringArg name] -text2 :: String -> String -> CabProp+text2 :: Text -> Text -> CabProp text2 name1 name2 = mkProperty "text" [StringArg name1, StringArg name2]  value :: Float -> CabProp@@ -140,7 +141,7 @@ latched :: Bool -> CabProp latched b = mkProperty "latched" [boolProp b] -identchannel :: String -> CabProp+identchannel :: Text -> CabProp identchannel s = mkProperty "identchannel" [StringArg s]  rotate :: Float -> Float -> Float -> CabProp@@ -152,40 +153,40 @@ visible :: Bool -> CabProp visible a = mkProperty "visible" [boolProp a] -caption :: String -> CabProp+caption :: Text -> CabProp caption a = mkProperty "caption" [StringArg a] -widgetarray :: String -> Int -> CabProp+widgetarray :: Text -> Int -> CabProp widgetarray name n = mkProperty "widgetarray" [StringArg name, IntArg n] -popuptext :: String -> CabProp+popuptext :: Text -> CabProp popuptext a = mkProperty "popuptext" [StringArg a]  active :: Bool -> CabProp active a = mkProperty "active" [boolProp a] -svgfile :: String -> String -> CabProp+svgfile :: Text -> Text -> CabProp svgfile ty fileName = mkProperty "svgfile" (fmap StringArg [ty, fileName]) -populate :: String -> String -> CabProp+populate :: Text -> Text -> CabProp populate filetype dir = mkProperty "populate" (fmap StringArg [filetype, dir]) -mode :: String -> CabProp+mode :: Text -> CabProp mode a = mkProperty "mode" [StringArg a] -file :: String -> CabProp+file :: Text -> CabProp file a = mkProperty "file" [StringArg a] -shape :: String -> CabProp+shape :: Text -> CabProp shape a = mkProperty "shape" [StringArg a]  corners :: Float -> CabProp corners a = mkProperty "corners" [FloatArg a] -channeltype :: String -> CabProp+channeltype :: Text -> CabProp channeltype a = mkProperty "channeltype" [StringArg a] -align :: String -> CabProp+align :: Text -> CabProp align a = mkProperty "align" [StringArg a]  sliderincr :: Float -> CabProp@@ -215,13 +216,13 @@ size :: Int -> Int -> CabProp size w h = mkProperty "size" (fmap IntArg [w, h]) -pluginid :: String -> CabProp+pluginid :: Text -> CabProp pluginid a = mkProperty "pluginid" [StringArg a]  guirefresh :: Int -> CabProp guirefresh a = mkProperty "guirefresh" [IntArg a] -plant :: String -> CabProp+plant :: Text -> CabProp plant a = mkProperty "plant" [StringArg a]  child :: Bool -> CabProp@@ -239,7 +240,7 @@ scrollbars :: Bool -> CabProp scrollbars a = mkProperty "scrollbars" [boolProp a] -fontstyle :: String -> CabProp+fontstyle :: Text -> CabProp fontstyle a = mkProperty "fontstyle" [StringArg a]  scrubberpos :: Int -> CabProp@@ -248,7 +249,7 @@ zoom :: Float -> CabProp zoom a = mkProperty "zoom" [FloatArg a] -displaytype :: String -> CabProp+displaytype :: Text -> CabProp displaytype a = mkProperty "displaytype" [StringArg a]  updaterate :: Int -> CabProp

@@ -2,21 +2,22 @@   Lang, Line(..), Property(..), Arg(..), ppCabbage ) where -import Text.PrettyPrint.Leijen+import Data.Text (Text)+import Text.PrettyPrint.Leijen.Text  type Lang = [Line]  data Line = Line-  { lineDef :: String+  { lineDef :: Text   , lineProperties :: [Property]   }  data Property = Property-  { propertyName :: String+  { propertyName :: Text   , propertyArgs :: [Arg]   } -data Arg = StringArg String | FloatArg Float | IntArg Int | ColonArg Float Float+data Arg = StringArg Text | FloatArg Float | IntArg Int | ColonArg Float Float  -------------------------------------------------- -- pretty print@@ -25,14 +26,14 @@ ppCabbage xs = vcat $ fmap ppLine xs  ppLine :: Line -> Doc-ppLine (Line name props) = text name <+> hcat (punctuate comma (fmap ppProp props))+ppLine (Line name props) = textStrict name <+> hcat (punctuate comma (fmap ppProp props))  ppProp :: Property -> Doc-ppProp (Property name args) = text name <> tupled (fmap ppArg args)+ppProp (Property name args) = textStrict name <> tupled (fmap ppArg args)  ppArg :: Arg -> Doc ppArg x = case x of-  StringArg s -> dquotes (text s)+  StringArg s -> dquotes (textStrict s)   FloatArg a  -> float a   IntArg a    -> int a   ColonArg a b -> float a <> colon <> float b

@@ -30,17 +30,19 @@ ) where  import Prelude hiding(elem, span)+import Data.Text (Text)+import Data.Text qualified as Text  import Data.Default import Data.Maybe(isNothing) import Data.Monoid  import qualified Data.IntMap as IM-import Text.PrettyPrint.Leijen(Doc)+import Text.PrettyPrint.Leijen.Text (Doc)  import Csound.Dynamic(DepT, depT_, Var(..), VarType(..), Rate(..), noRate, MainExp(..), InstrId(..)) -import qualified Text.PrettyPrint.Leijen as P(int, double, vcat, empty, text)+import qualified Text.PrettyPrint.Leijen.Text as P(int, double, vcat, empty, textStrict) import qualified Csound.Typed.Gui.BoxModel as Box import Csound.Typed.Constants(infiniteDur) @@ -59,7 +61,7 @@         { singleContent :: Win         , singleIsKeybdSensitive :: Bool }     | Tabs-        { tabsTitle     :: String+        { tabsTitle     :: Text         , tabsRect      :: Maybe Rect         , tabsContent   :: [Win]         , tabsIsKeybdSensitive :: Bool }@@ -70,7 +72,7 @@     Tabs _ _ _ res -> res  data Win = Win-    { winTitle :: String+    { winTitle :: Text     , winRect  :: Maybe Rect     , winGui   :: Gui } @@ -99,7 +101,7 @@     | Text   ValDiap ValStep      -- other widgets-    | Box String+    | Box Text     | ButBank Int Int     | Button InstrId     | Toggle@@ -108,7 +110,7 @@  type ElemOuts = [Var] -defText :: String -> Gui+defText :: Text -> Gui defText str = Gui $ Box.Prim (ElemWithOuts [Var LocalVar Ir "keybd"] [] $ Box str)  fromElem :: ElemOuts -> [InitMe] -> Elem -> Gui@@ -226,7 +228,7 @@ guiStmt defaultScaleUI panels = depT_ $ noRate (phi defaultScaleUI)     where phi scaleUI             | null panels = EmptyExp-            | otherwise   = Verbatim $ show $ P.vcat [P.vcat $ fmap (drawGui scaleUI) panels, P.text "FLrun"]+            | otherwise   = Verbatim $ Text.pack $ show $ P.vcat [P.vcat $ fmap (drawGui scaleUI) panels, P.textStrict "FLrun"]  drawGui :: ScaleFactor -> Panel -> Doc drawGui defaultScaleUI x = case x of@@ -249,7 +251,7 @@            onPanel title isKeybdSensitive rect body = P.vcat             -- panel with default position no border and capture of keyboard events-            [ ppProc "FLpanel" [ P.text $ show title, P.int $ width rect, P.int $ height rect, P.int (-1), P.int (-1), P.int 0+            [ ppProc "FLpanel" [ P.textStrict title, P.int $ width rect, P.int $ height rect, P.int (-1), P.int (-1), P.int 0                                , P.int $ if isKeybdSensitive then 1 else 0 ]             , body             , ppProc "FLpanelEnd" []]@@ -260,7 +262,7 @@             , ppProc "FLtabsEnd" []]  -panelTitle :: Panel -> String+panelTitle :: Panel -> Text panelTitle x = case x of     Single w _       -> winTitle w     Tabs title _ _ _ -> title@@ -302,7 +304,7 @@ drawTab :: (Int, Int) -> Rect -> Win -> Doc drawTab shift r w = group (winTitle w) r $ drawWin (withRelWinMargin $ shiftRect shift r) w     where group title rect body = P.vcat-            [ ppProc "FLgroup" $ (P.text $ show title) : rectToFrame rect+            [ ppProc "FLgroup" $ (P.textStrict $ Text.pack $ show title) : rectToFrame rect             , body             , ppProc "FLgroupEnd" []] @@ -324,7 +326,7 @@  drawBorder :: BorderType -> Rect -> Doc -> Doc drawBorder borderType rect a = P.vcat-    [ ppProc "FLgroup" $ ((P.text $ show "") : frame) ++ [borderAsInt borderType]+    [ ppProc "FLgroup" $ (P.empty : frame) ++ [borderAsInt borderType]     , a     , ppProc "FLgroupEnd" []]     where borderAsInt = P.int . fromEnum@@ -371,7 +373,9 @@             where label = getLabel ctx          f = fWithLabel (getLabel ctx)-        fWithLabel label name args = ppMoOpc (fmap ppVar $ elemOuts el) name ((P.text $ show $ label) : args)++        fWithLabel :: Text -> Text -> [Doc] -> Doc+        fWithLabel label name args = ppMoOpc (fmap ppVar $ elemOuts el) name ((P.textStrict label) : args)         fNoLabel name args = ppMoOpc (fmap ppVar $ elemOuts el) name args         frame = frameBy rect         frameWithoutLabel = frameBy rectWithoutLabel@@ -464,7 +468,7 @@ setProp :: Prop -> Gui -> Gui setProp p = props [p] -setLabel :: String -> Gui -> Gui+setLabel :: Text -> Gui -> Gui setLabel = setProp . SetLabel  setLabelType :: LabelType -> Gui -> Gui@@ -580,7 +584,7 @@     -- other widgets     Box     label    ->         let symbolsPerLine = 60-            numOfLines = succ $ div (length label) symbolsPerLine+            numOfLines = succ $ div (Text.length label) symbolsPerLine         in  (xBox 15 symbolsPerLine, yBox 15 numOfLines)      ButBank xn yn   -> (xn * 70, yn * 35)@@ -618,7 +622,7 @@ flSetColor, flSetColor2, flSetTextColor, flSetTextSize, flSetTextType,     flSetFont :: Var -> PropCtx -> Doc -flSetProp :: String+flSetProp :: Text     -> (PropCtx -> Maybe a)     -> (PropCtx -> Doc)     -> Var -> PropCtx -> Doc

@@ -7,13 +7,14 @@   getToggleType, appMaterial, getColor1, getColor2, getTextColor, genGetColor ) where -import Data.Char import Data.Default import Data.Colour.Names(white, gray, black) import Data.Colour.SRGB+import Data.Text (Text)+import Data.Text qualified as Text -import Text.PrettyPrint.Leijen(Doc, int, hcat, hsep, punctuate, comma, text, char)-import qualified Text.PrettyPrint.Leijen as P((<+>), empty)+import Text.PrettyPrint.Leijen.Text(Doc, int, hcat, hsep, punctuate, comma, textStrict, char)+import qualified Text.PrettyPrint.Leijen.Text as P((<+>), empty)  import Csound.Dynamic(Var(..), VarType(..), Rate(..)) @@ -22,17 +23,17 @@ ------------------------------------------------------------- -- pretty printers -ppProc :: String -> [Doc] -> Doc-ppProc name xs = text name P.<+> (hsep $ punctuate comma xs)+ppProc :: Text -> [Doc] -> Doc+ppProc name xs = textStrict name P.<+> (hsep $ punctuate comma xs) -ppMoOpc :: [Doc] -> String -> [Doc] -> Doc-ppMoOpc outs name ins = f outs P.<+> text name P.<+> f ins+ppMoOpc :: [Doc] -> Text -> [Doc] -> Doc+ppMoOpc outs name ins = f outs P.<+> textStrict name P.<+> f ins     where f = hsep . punctuate comma  ppVar :: Var -> Doc ppVar v = case v of-    Var ty rate name   -> hcat [ppVarType ty, ppRate rate, text (varPrefix ty : name)]-    VarVerbatim _ name -> text name+    Var ty rate name   -> hcat [ppVarType ty, ppRate rate, textStrict (Text.cons (varPrefix ty) name)]+    VarVerbatim _ name -> textStrict name  varPrefix :: VarType -> Char varPrefix x = case x of@@ -48,7 +49,7 @@ ppRate x = case x of     Sr -> char 'S'     _  -> phi x-    where phi = text . map toLower . show+    where phi = textStrict . Text.toLower . Text.pack . show  ------------------------------------------------------------------ -- Converting readable properties to integer codes

@@ -28,6 +28,7 @@ import Data.Colour  import Csound.Typed.Gui.BoxModel(Rect(..))+import Data.Text (Text)  -- | The Csound colours. type Color = Colour Double@@ -42,8 +43,8 @@ -- | A value span is a diapason of the value and a type -- of the scale (can be linear or exponential). data ValSpan = ValSpan-    { valSpanDiap  :: ValDiap-    , valSpanScale :: ValScaleType }+    { valSpanDiap  :: !ValDiap+    , valSpanScale :: !ValScaleType }  -- | Makes a linear @ValSpan@ with specified boundaries. --@@ -190,7 +191,7 @@  -- | Properties of the widgets. data Prop-    = SetLabel String+    = SetLabel Text     | SetMaterial Material     | SetBoxType BoxType     | SetColor1 Color | SetColor2 Color | SetTextColor Color@@ -206,7 +207,7 @@ -- cascading context, here we group properties by type  data PropCtx = PropCtx-    { ctxLabel        :: Maybe String+    { ctxLabel        :: Maybe Text     , ctxMaterial     :: Maybe Material     , ctxLabelType    :: Maybe LabelType     , ctxBoxType      :: Maybe BoxType@@ -245,5 +246,5 @@             SetTextType     a -> x { ctxTextType = Just a }             SetKnobType     a -> x { ctxKnobType = Just a } -getLabel :: PropCtx -> String+getLabel :: PropCtx -> Text getLabel = maybe "" id . ctxLabel

@@ -26,6 +26,8 @@ import Control.Monad.Trans.Class  import Data.Boolean+import Data.Text (Text)+import Data.Text qualified as Text  import Csound.Dynamic hiding (int, when1) import qualified Csound.Typed.GlobalState.Elements as C@@ -58,41 +60,41 @@  -- | Renders the GUI elements with tabs. Rectangles are calculated -- automatically.-tabs :: [(String, Gui)] -> SE ()+tabs :: [(Text, Gui)] -> SE () tabs = genTabs False  -- | Renders the GUI elements with tabs. Rectangles are calculated -- automatically.-keyTabs :: [(String, Gui)] -> SE ()+keyTabs :: [(Text, Gui)] -> SE () keyTabs = genTabs True -genTabs :: Bool -> [(String, Gui)] -> SE ()+genTabs :: Bool -> [(Text, Gui)] -> SE () genTabs isKey xs = geToSe $ saveGuiRoot $ Tabs "" Nothing (fmap (\(title, gui) -> Win title Nothing gui) xs) isKey  -- | Renders the GUI elements on the window. We can specify the window title -- and rectangle of the window.-panelBy :: String -> Maybe Rect -> Gui -> SE ()+panelBy :: Text -> Maybe Rect -> Gui -> SE () panelBy = genPanelBy False  -- | Renders the GUI elements on the window. We can specify the window title -- and rectangle of the window. Panesls are sensitive to keyboard events.-keyPanelBy :: String -> Maybe Rect -> Gui -> SE ()+keyPanelBy :: Text -> Maybe Rect -> Gui -> SE () keyPanelBy = genPanelBy True -genPanelBy :: Bool -> String -> Maybe Rect -> Gui -> SE ()+genPanelBy :: Bool -> Text -> Maybe Rect -> Gui -> SE () genPanelBy isKeybd title mrect gui = geToSe $ saveGuiRoot $ Single (Win title mrect gui) isKeybd  -- | Renders the GUI elements with tabs. We can specify the window title and -- rectangles for all tabs and for the main window.-tabsBy :: String -> Maybe Rect -> [(String, Maybe Rect, Gui)] -> SE ()+tabsBy :: Text -> Maybe Rect -> [(Text, Maybe Rect, Gui)] -> SE () tabsBy = genTabsBy False  -- | Renders the GUI elements with tabs. We can specify the window title and -- rectangles for all tabs and for the main window. Tabs are sensitive to keyboard events.-keyTabsBy :: String -> Maybe Rect -> [(String, Maybe Rect, Gui)] -> SE ()+keyTabsBy :: Text -> Maybe Rect -> [(Text, Maybe Rect, Gui)] -> SE () keyTabsBy = genTabsBy True -genTabsBy :: Bool -> String -> Maybe Rect -> [(String, Maybe Rect, Gui)] -> SE ()+genTabsBy :: Bool -> Text -> Maybe Rect -> [(Text, Maybe Rect, Gui)] -> SE () genTabsBy isKeybd title mrect gui = geToSe $ saveGuiRoot $ Tabs title mrect (fmap (\(a, b, c) -> Win a b c) gui) isKeybd  -- | Widgets that produce something has inputs.@@ -197,33 +199,33 @@ -- primitive elements  -- | Appends a title to a group of widgets.-setTitle :: String -> Gui -> SE Gui+setTitle :: Text -> Gui -> SE Gui setTitle name g-    | null name = return g+    | Text.null name = return g     | otherwise = do         gTitle <- box name         return $ ver [sca 0.01 gTitle, g] -setSourceTitle :: String -> Source a -> Source a+setSourceTitle :: Text -> Source a -> Source a setSourceTitle name ma = source $ do     (gui, val) <- ma     newGui <- setTitle name gui     return (newGui, val) -setLabelSource :: String -> Source a -> Source a+setLabelSource :: Text -> Source a -> Source a setLabelSource a-    | null a    = id+    | Text.null a    = id     | otherwise = fmap (first $ setLabel a) -setLabelSink :: String -> Sink a -> Sink a+setLabelSink :: Text -> Sink a -> Sink a setLabelSink a-    | null a    = id+    | Text.null a = id     | otherwise = fmap (first $ setLabel a) -setLabelSnkSource :: String -> SinkSource a -> SinkSource a+setLabelSnkSource :: Text -> SinkSource a -> SinkSource a setLabelSnkSource a-    | null a    = id-    | otherwise = fmap (\(x, y, z) -> (setLabel a x, y, z))+    | Text.null a = id+    | otherwise   = fmap (\(x, y, z) -> (setLabel a x, y, z))  singleOut :: Maybe Double -> Elem -> Source Sig singleOut v0 el = geToSe $ do@@ -290,7 +292,7 @@ -- > knob valueSpan initValue -- -- doc: <http://www.csounds.com/manual/html/FLknob.html>-knob :: String -> ValSpan -> Double -> Source Sig+knob :: Text -> ValSpan -> Double -> Source Sig knob name sp v0 = setLabelSource name $ singleOut (Just v0) $ Knob sp  -- | FLroller is a sort of knob, but put transversally.@@ -298,7 +300,7 @@ -- > roller valueSpan step initVal -- -- doc: <http://www.csounds.com/manual/html/FLroller.html>-roller :: String -> ValSpan -> ValStep -> Double -> Source Sig+roller :: Text -> ValSpan -> ValStep -> Double -> Source Sig roller name sp step v0 = setLabelSource name $ singleOut (Just v0) $ Roller sp step  -- | FLslider puts a slider into the corresponding container.@@ -306,14 +308,14 @@ -- > slider valueSpan initVal -- -- doc: <http://www.csounds.com/manual/html/FLslider.html>-slider :: String -> ValSpan -> Double -> Source Sig+slider :: Text -> ValSpan -> Double -> Source Sig slider name sp v0 = setLabelSource name $ singleOut (Just v0) $ Slider sp  -- | Constructs a list of linear unit sliders (ranges in [0, 1]). It takes a list -- of init values.-sliderBank :: String -> [Double] -> Source [Sig]+sliderBank :: Text -> [Double] -> Source [Sig] sliderBank name ds = source $ do-    (gs, vs) <- fmap unzip $ zipWithM (\n d -> slider (show n) uspan d) [(1::Int) ..] ds+    (gs, vs) <- fmap unzip $ zipWithM (\n d -> slider (Text.pack $ show n) uspan d) [(1::Int) ..] ds     gui <- setTitle name  $ hor gs     return (gui, vs) @@ -323,7 +325,7 @@ -- > numeric diapason step initValue -- -- doc: <http://www.csounds.com/manual/html/FLtext.html>-numeric :: String -> ValDiap -> ValStep -> Double -> Source Sig+numeric :: Text -> ValDiap -> ValStep -> Double -> Source Sig numeric name diap step v0 = setLabelSource name $ singleOut (Just v0) $ Text diap step  -- | A FLTK widget that displays text inside of a box.@@ -333,18 +335,18 @@ -- > box text -- -- doc: <http://www.csounds.com/manual/html/FLbox.html>-box :: String -> Display+box :: Text -> Display box label-    | length label < lim = rawBox label-    | otherwise          = fmap (padding 0 . ver) $ mapM rawBox $ parts lim label+    | Text.length label < lim = rawBox label+    | otherwise               = fmap (padding 0 . ver) $ mapM rawBox $ parts lim label     where         parts n xs-            | length xs < n = [xs]+            | Text.length xs < n = [xs]             | otherwise     = a : parts n b-            where (a, b) = splitAt n xs+            where (a, b) = Text.splitAt n xs         lim = 255 -rawBox :: String -> Display+rawBox :: Text -> Display rawBox label = geToSe $ do     (_, handle) <- newGuiVar     let gui = fromElem [guiHandleToVar handle] [] (Box label)@@ -356,7 +358,7 @@ -- > button text -- -- doc: <http://www.csounds.com/manual/html/FLbutton.html>-button :: String -> Source (Evt Unit)+button :: Text -> Source (Evt Unit) button name = setLabelSource name $ source $ do     flag <- geToSe $ onGlobals $ C.newPersistentGlobalVar Kr 0     flagChanged <- geToSe $ onGlobals $ C.newPersistentGlobalVar Kr 0@@ -368,9 +370,9 @@     where         instr ref = SE $ do             val <- readVar ref-            whens Kr-                [ (val ==* 0, writeVar ref 1)-                ] (writeVar ref 0)+            whens IfKr+                [ (val ==* 0, toBlock $ writeVar ref 1)+                ] (toBlock $ writeVar ref 0)             turnoff          instrCh ref refCh = SE $ do@@ -382,12 +384,12 @@ -- > button text -- -- doc: <http://www.csounds.com/manual/html/FLbutton.html>-toggle :: String -> Bool -> Source (Evt D)+toggle :: Text -> Bool -> Source (Evt D) toggle name initVal = mapSource snaps $ toggleSig name initVal  -- | A variance on the function 'Csound.Gui.Widget.toggle', but it produces -- a signal of piecewise constant function.-toggleSig :: String -> Bool -> Source Sig+toggleSig :: Text -> Bool -> Source Sig toggleSig name initVal = setLabelSource name $ singleOut (initToggle initVal) Toggle  initToggle :: Bool -> Maybe Double@@ -399,7 +401,7 @@ -- > butBank xNumOfButtons yNumOfButtons -- -- doc: <http://www.csounds.com/manual/html/FLbutBank.html>-butBank :: String -> Int -> Int -> (Int, Int) -> Source (Evt (D, D))+butBank :: Text -> Int -> Int -> (Int, Int) -> Source (Evt (D, D)) butBank name xn yn inits = mapSource (fmap split2 . snaps) $ butBankSig1 name xn yn inits     where         split2 a = (floor' $ a / y, mod' a x)@@ -409,7 +411,7 @@ -- | A variance on the function 'Csound.Gui.Widget.butBank', but it produces -- a signal of piecewise constant function. -- Result is (x, y) coordinate of the triggered button.-butBankSig :: String -> Int -> Int -> (Int, Int) -> Source (Sig, Sig)+butBankSig :: Text -> Int -> Int -> (Int, Int) -> Source (Sig, Sig) butBankSig name xn yn inits = mapSource split2 $ butBankSig1 name xn yn inits     where         split2 a = (floor' $ a / y, mod' a x)@@ -421,39 +423,39 @@ -- > butBank xNumOfButtons yNumOfButtons -- -- doc: <http://www.csounds.com/manual/html/FLbutBank.html>-butBank1 :: String -> Int -> Int -> (Int, Int) -> Source (Evt D)+butBank1 :: Text -> Int -> Int -> (Int, Int) -> Source (Evt D) butBank1 name xn yn inits = mapSource snaps $ butBankSig1 name xn yn inits -butBankSig1 :: String -> Int -> Int -> (Int, Int) -> Source Sig+butBankSig1 :: Text -> Int -> Int -> (Int, Int) -> Source Sig butBankSig1 name xn yn (x0, y0) = setSourceTitle name $ singleOut (Just n) $ ButBank xn yn     where n = fromIntegral $ y0 + x0 * yn  -- |  FLtext that is sink shows current the value of a valuator in a text field.-setNumeric :: String -> ValDiap -> ValStep -> Double -> Sink Sig+setNumeric :: Text -> ValDiap -> ValStep -> Double -> Sink Sig setNumeric name diap step v0 = setLabelSink name $ singleIn printk2 (Just v0) $ Text diap step  -- | A slider that serves as indicator. It consumes values instead of producing. -- -- > meter valueSpan initValue-meter :: String -> ValSpan -> Double -> Sink Sig+meter :: Text -> ValSpan -> Double -> Sink Sig meter name sp v = setLabelSink name $ singleIn setVal (Just v) (Slider sp)  ------------------------------------------------------------- -- writeable widgets -setToggleSig :: String -> Bool -> SinkSource Sig+setToggleSig :: Text -> Bool -> SinkSource Sig setToggleSig name initVal = setLabelSnkSource name $ singleInOut setVal (initToggle initVal) Toggle -setToggle :: String -> Bool -> SinkSource (Evt D)+setToggle :: Text -> Bool -> SinkSource (Evt D) setToggle name initVal = sinkSource $ do     (g, outs, ins) <- setToggleSig name initVal     let evtOuts a = outs =<< stepper 0 (fmap sig a)     return (g, evtOuts, snaps ins) -setKnob :: String -> ValSpan -> Double -> SinkSource Sig+setKnob :: Text -> ValSpan -> Double -> SinkSource Sig setKnob name sp v0 = setLabelSnkSource name $ singleInOut setVal' (Just v0) $ Knob sp -setSlider :: String -> ValSpan -> Double -> SinkSource Sig+setSlider :: Text -> ValSpan -> Double -> SinkSource Sig setSlider name sp v0 = setLabelSnkSource name $ singleInOut setVal' (Just v0) $ Slider sp  -------------------------------------------------------------

@@ -23,7 +23,7 @@ import System.FilePath import Text.Read (readMaybe) -import Text.PrettyPrint.Leijen(displayS, renderPretty)+import Text.PrettyPrint.Leijen.Text (displayTStrict, renderPretty)  import Csound.Dynamic hiding (csdFlags) import Csound.Typed.Types@@ -59,24 +59,31 @@  renderOutBy_ :: Options -> SE () -> IO String renderOutBy_ options sigs = do-    finalOptions <- fmap (maybe options (options `mappend` )) getUserOptions-    evalGE finalOptions $ fmap renderCsd $ toCsd Nothing finalOptions (fmap (const unit) sigs)+  finalOptions <- fmap (maybe options (options `mappend` )) getUserOptions+  evalGE finalOptions $ fmap (renderCsd renderOpts) $ toCsd Nothing finalOptions (fmap (const unit) sigs)+  where+    renderOpts = fromMaybe def $ csdRender options + renderOut :: Sigs a => SE a -> IO String renderOut = renderOutBy def  renderOutBy :: Sigs a => Options -> SE a -> IO String renderOutBy options sigs = do-    finalOptions <- fmap (maybe options (options `mappend` )) getUserOptions-    evalGE finalOptions $ fmap renderCsd $ toCsd Nothing finalOptions sigs+  finalOptions <- fmap (maybe options (options `mappend` )) getUserOptions+  evalGE finalOptions $ fmap (renderCsd renderOpts) $ toCsd Nothing finalOptions sigs+  where+    renderOpts = fromMaybe def $ csdRender options  renderEff :: (Sigs a, Sigs b) => (a -> SE b) -> IO String renderEff = renderEffBy def  renderEffBy :: (Sigs a, Sigs b) => Options -> (a -> SE b) -> IO String renderEffBy options eff = do-    finalOptions <- fmap (maybe options (options `mappend` )) getUserOptions-    evalGE finalOptions $ fmap renderCsd $ toCsd (Just (arityIns $ funArity eff)) finalOptions (eff =<< getIns)+  finalOptions <- fmap (maybe options (options `mappend` )) getUserOptions+  evalGE finalOptions $ fmap (renderCsd renderOpts) $ toCsd (Just (arityIns $ funArity eff)) finalOptions (eff =<< getIns)+  where+    renderOpts = fromMaybe def $ csdRender options  renderHistory :: Maybe Int -> Int -> Options -> GE Csd renderHistory mnchnls_i nchnls opt = do@@ -106,7 +113,7 @@          getPlugins hist = case cabbageGui hist of                 Nothing -> []-                Just x  -> [(Plugin "Cabbage" (displayS (renderPretty 1 10000 $ ppCabbage x) ""))]+                Just x  -> [(Plugin "Cabbage" (displayTStrict (renderPretty 1 10000 $ ppCabbage x)))]  getInstr0 :: Maybe Int -> Int -> Options -> Dep () -> History -> Dep () getInstr0 mnchnls_i nchnls opt udos hist = do

@@ -8,15 +8,16 @@     -- can use these functions.     withInits, withDs, withSigs, withTabs, withD, withSig, withTab, withSeed,     -- * Tuples-    module Csound.Typed.Types.Tuple,        +    module Csound.Typed.Types.Tuple,     -- * Events     module Csound.Typed.Types.Evt,      -- * Arrays-    module Csound.Typed.Types.Array, +    module Csound.Typed.Types.Array,+    module Csound.Typed.Types.PureArray,      -- * Arguments for monophonic synths-    module Csound.Typed.Types.MonoArg,  +    module Csound.Typed.Types.MonoArg,      -- * Signal space (generic signal transformers)     module Csound.Typed.Types.SigSpace,@@ -32,6 +33,7 @@ import Csound.Typed.Types.Evt import Csound.Typed.Types.Lift import Csound.Typed.Types.Array+import Csound.Typed.Types.PureArray import Csound.Typed.Types.MonoArg import Csound.Typed.Types.SigSpace @@ -50,7 +52,7 @@ withInits :: (Tuple a, Tuple b) => a -> b -> a withInits a b = genWithInits a (fromTuple b) --- | A special case of @withInits@. Here all inits are numbers. +-- | A special case of @withInits@. Here all inits are numbers. withDs :: Tuple a => a -> [D] -> a withDs a ds = genWithInits a (mapM toGE ds) @@ -58,7 +60,7 @@ withD :: Tuple a => a -> D -> a withD = withInits --- | A special case of @withInits@. Here all inits are signals. +-- | A special case of @withInits@. Here all inits are signals. withSigs :: Tuple a => a -> [Sig] -> a withSigs a sigs = genWithInits a (mapM toGE sigs) @@ -66,7 +68,7 @@ withSig :: Tuple a => a -> Sig -> a withSig = withInits --- | A special case of @withInits@. Here all inits are arrays. +-- | A special case of @withInits@. Here all inits are arrays. withTabs :: Tuple a => a -> [Tab] -> a withTabs a tabs = genWithInits a (mapM toGE tabs) @@ -74,8 +76,8 @@ withTab :: Tuple a => a -> Tab -> a withTab = withInits --- | Applies a seed to the random value. --- It's equivalent to the @withD@ but it has a special +-- | Applies a seed to the random value.+-- It's equivalent to the @withD@ but it has a special -- meaning of canceling the side effect. When random -- opcode is provided with seed value it's no longer -- contains a side effect so we don't need to restrict it.

@@ -31,6 +31,8 @@   import Control.Monad+import Data.Proxy+import Data.Text (Text)  import Csound.Dynamic hiding (writeArr, writeInitArr, readArr, newLocalArrVar, newTmpArrVar, int) import qualified Csound.Dynamic as D@@ -89,7 +91,7 @@  newArrBy :: forall ix a . (Tuple a, Tuple ix) => (Rate -> GE [E] -> SE Var) -> [D] -> SE (Arr ix a) newArrBy mkVar sizes =-    fmap Arr $ mapM (\x -> mkVar x (mapM toGE sizes)) (tupleRates $ (undefined :: a))+    fmap Arr $ mapM (\x -> mkVar x (mapM toGE sizes)) (tupleRates $ (Proxy :: Proxy a))  getIndices :: Tuple ix => [Int] -> [ix] getIndices xs = fmap (toTuple . return . fmap D.int) $ getIntIndices xs@@ -417,7 +419,7 @@ isArrayInit = True noArrayInit = False -binOp :: String -> Arr a b -> Arr a b -> SE (Arr a b)+binOp :: Text -> Arr a b -> Arr a b -> SE (Arr a b) binOp name (Arr xs) (Arr ys) = fmap Arr $ zipWithM go xs ys     where         go x y = SE $ do@@ -425,7 +427,7 @@             infOprArr isArrayInit outVar name (inlineVar x) (inlineVar y)             return outVar -convert :: String -> Arr a b -> SE (Arr a b)+convert :: Text -> Arr a b -> SE (Arr a b) convert name (Arr vars) = fmap Arr $ mapM go vars     where         go v = SE $ do@@ -435,7 +437,7 @@          idRate1 = fmap (\r -> (r, [r])) [Kr, Ar, Ir, Sr, Fr] -convert2 :: String -> Arr a b -> Arr a b -> SE (Arr a b)+convert2 :: Text -> Arr a b -> Arr a b -> SE (Arr a b) convert2 name (Arr xs) (Arr ys) = fmap Arr $ zipWithM go xs ys     where         go x y = SE $ do@@ -445,15 +447,15 @@          idRate2 = fmap (\r -> (r, [r, r])) [Kr, Ar, Ir, Sr, Fr] -extractArray :: (Tuple b) => String -> Arr a b -> SE b+extractArray :: (Tuple b) => Text -> Arr a b -> SE b extractArray name (Arr vs) = SE $ fmap (toTuple . return) $ mapM (f . inlineVar) vs     where f a = depT $ opcs name [(Xr, [Xr])] [a] -extract1 :: (Tuple b, Tuple c) => Rate -> String -> Arr a b -> SE c+extract1 :: (Tuple b, Tuple c) => Rate -> Text -> Arr a b -> SE c extract1 rate name (Arr vs) = SE $ fmap (toTuple . return) $ mapM (f . inlineVar) vs     where f a = depT $ opcs name [(rate, [Xr])] [a] -extractWith :: (Tuple b, Tuple c, Tuple d) => String -> (Rate, [Rate]) -> Arr a b -> c -> SE d+extractWith :: (Tuple b, Tuple c, Tuple d) => Text -> (Rate, [Rate]) -> Arr a b -> c -> SE d extractWith name rates (Arr vs) argument = SE $ fmap (toTuple . return) $ hideGEinDep $ do         argExps <- fromTuple argument         return $ zipWithM (\var x -> f (inlineVar var) x) vs argExps@@ -600,18 +602,18 @@  --------------------------------------------------------------- -binOpCopy :: String -> Arr a b -> Arr a b -> Arr a b -> SE ()+binOpCopy :: Text -> Arr a b -> Arr a b -> Arr a b -> SE () binOpCopy name (Arr xs) (Arr ys) (Arr outs) = mapM_ go $ zip3 xs ys outs     where         go (x, y, outVar) = SE $ infOprArr noArrayInit outVar name (inlineVar x) (inlineVar y) -convertCopy :: String -> Arr a b -> Arr a b -> SE ()+convertCopy :: Text -> Arr a b -> Arr a b -> SE () convertCopy name (Arr vars) (Arr outs) = zipWithM_ go vars outs     where         go v outVar = SE $ opcsArr noArrayInit outVar name idRate1 [inlineVar v]         idRate1 = fmap (\r -> (r, [r])) [Kr, Ar, Ir, Sr, Fr] -convert2Copy :: String -> Arr a b -> Arr a b -> Arr a b -> SE ()+convert2Copy :: Text -> Arr a b -> Arr a b -> Arr a b -> SE () convert2Copy name (Arr xs) (Arr ys) (Arr outs) = mapM_ go $ zip3 xs ys outs     where         go (x, y, outVar) = SE $ opcsArr noArrayInit outVar name idRate2 [inlineVar x, inlineVar y]

@@ -8,6 +8,7 @@  import Data.Default import Data.Boolean+import Data.Kind (Type)  import Csound.Typed.Types.Prim import Csound.Typed.Types.Tuple@@ -57,15 +58,15 @@ sigToEvt = boolToEvt . ( ==* 1) . kr  -- | Filters events with predicate.-filterE :: (a -> BoolD) -> Evt a -> Evt a+filterE :: (a -> BoolSig) -> Evt a -> Evt a filterE pr evt = Evt $ \bam -> runEvt evt $ \a ->-    when1 (boolSig $ pr a) $ bam a+    when1 (pr a) $ bam a  -- | Filters events with effectful predicate.-filterSE :: (a -> SE BoolD) -> Evt a -> Evt a+filterSE :: (a -> SE BoolSig) -> Evt a -> Evt a filterSE mpr evt = Evt $ \bam -> runEvt evt $ \a -> do     pr <- mpr a-    when1 (boolSig pr) $ bam a+    when1 pr $ bam a  -- | Accumulator for events with side effects. accumSE :: (Tuple s) => s -> (a -> s -> SE (b, s)) -> Evt a -> Evt b@@ -83,19 +84,19 @@  -- | Accumulator for events with side effects and filtering. Event triggers -- only if the first element in the tripplet is true.-filterAccumSE :: (Tuple s) => s -> (a -> s -> SE (BoolD, b, s)) -> Evt a -> Evt b+filterAccumSE :: (Tuple s) => s -> (a -> s -> SE (BoolSig, b, s)) -> Evt a -> Evt b filterAccumSE s0 update evt = Evt $ \bam -> do     (readSt, writeSt) <- sensorsSE s0     runEvt evt $ \a -> do         s1 <- readSt         (isOn, b, s2) <- update a s1-        when1 (boolSig isOn) $ bam b+        when1 isOn $ bam b         writeSt s2  -- | Accumulator with filtering. It can skip the events from the event stream. -- If the third element of the triple equals to 1 then we should include the -- event in the resulting stream. If the element equals to 0 we skip the event.-filterAccumE :: (Tuple s) => s -> (a -> s -> (BoolD, b, s)) -> Evt a -> Evt b+filterAccumE :: (Tuple s) => s -> (a -> s -> (BoolSig, b, s)) -> Evt a -> Evt b filterAccumE s0 update = filterAccumSE s0 $ \a s -> return $ update a s  -- | Get values of some signal at the given events.@@ -131,7 +132,7 @@ -- > type instance Snap (a, b, c, d) = (Snap a, Snap b, Snap c, Snap d) -- > type instance Snap (a, b, c, d, e) = (Snap a, Snap b, Snap c, Snap d, Snap e) -- > type instance Snap (a, b, c, d, e, f) = (Snap a, Snap b, Snap c, Snap d, Snap e, Snap f)-type family Snap a :: *+type family Snap a :: Type  type instance Snap D   = D type instance Snap Str = Str

@@ -1,4 +1,4 @@-{-# Language FlexibleInstances #-}+{-# Language FlexibleInstances, ScopedTypeVariables #-} module Csound.Typed.Types.Lift(     GE, E,     -- * Lifters@@ -19,6 +19,7 @@  ) where +import Data.Proxy import Csound.Dynamic import Csound.Typed.Types.Prim import Csound.Typed.Types.Tuple@@ -60,17 +61,13 @@  -- multi out helpers -fromPm :: Tuple a => Pm -> a-fromPm (Pm a) = res-    where res = toTuple $ fmap ( $ tupleArity res) a--fromDm :: Tuple a => Dm -> SE a-fromDm (Dm a) = res-    where-        res = fmap toTuple $ fromDep $ hideGEinDep $ fmap ( $ (tupleArity $ proxy res)) a+fromPm :: forall a. Tuple a => Pm -> a+fromPm (Pm a) =+  toTuple $ fmap ( $ tupleArity (Proxy :: Proxy a)) a -        proxy :: SE a -> a-        proxy = const undefined+fromDm :: forall a. Tuple a => Dm -> SE a+fromDm (Dm a) =+  fmap toTuple $ fromDep $ hideGEinDep $ fmap ( $ (tupleArity (Proxy :: Proxy a))) a  -- pure single 

@@ -32,7 +32,7 @@     -- ** logic funs     when1, whens, untilDo, whileDo, boolSig,     equalsTo, notEqualsTo, lessThan, greaterThan, lessThanEquals, greaterThanEquals,-    whenD1, whenDs, untilDoD, whileDoD, untilBeginD,+    whenD1, whenDs, untilDoD, whileDoD ) where  import Prelude hiding ((<*))@@ -48,10 +48,13 @@  import Data.Default import Data.Boolean+import Data.Kind (Type) import Data.String+import Data.Text (Text)+import Data.Text qualified as Text -import Csound.Dynamic hiding (genId, double, int, str, when1, whens, ifBegin, ifEnd, elseBegin, untilBegin, untilEnd, untilDo, whileBegin, whileEnd, whileDo)-import qualified Csound.Dynamic as D(double, int, str, ifBegin, ifEnd, elseBegin, untilBegin, untilEnd, whileBegin, whileEnd)+import Csound.Dynamic hiding (genId, double, int, str, when1, whens, whileEnd)+import qualified Csound.Dynamic as D import Csound.Typed.GlobalState.GE import Csound.Typed.GlobalState.SE import Csound.Typed.GlobalState.Options@@ -169,7 +172,7 @@ preTab :: TabSize -> Int -> TabArgs -> Tab preTab size gen args = TabPre $ PreTab size (IntGenId gen) args -preStringTab :: TabSize -> String -> TabArgs -> Tab+preStringTab :: TabSize -> Text -> TabArgs -> Tab preStringTab size gen args = TabPre $ PreTab size (StringGenId gen) args  data PreTab = PreTab@@ -214,7 +217,7 @@ fromPreTab a = withOptions $ \opt -> go (defTabFi opt) a     where         go :: TabFi -> PreTab -> Gen-        go tabFi tab = Gen size (preTabGen tab) args file+        go tabFi tab = Gen size (preTabGen tab) args (Text.pack <$> file)             where size = defineTabSize (getTabSizeBase tabFi tab) (preTabSize tab)                   (args, file) = defineTabArgs size (preTabArgs tab) @@ -389,7 +392,7 @@      toGE x = case x of         Sig a       -> a-        PrimSig d   -> return $ D.double d+        PrimSig d   -> return $ setRate Kr $ D.double d  instance Val D      where     fromGE  = D@@ -548,7 +551,7 @@     ; asin = dOn1 asin asin; atan = dOn1 atan atan;  acos = dOn1 acos acos ; asinh = dOn1 asinh asinh; acosh = dOn1 acosh acosh; atanh = dOn1 atanh atanh }  class IsPrim a where-    type PrimOf a :: *+    type PrimOf a :: Type     getPrim :: a -> Maybe (PrimOf a)     fromPrim :: PrimOf a -> a @@ -628,27 +631,27 @@ instance IfB Sig  where     ifB x a b = case x of         PrimBoolSig c -> if c then a else b-        _                -> on3 ifB x a b+        _                -> on3 (ifExp IfKr) x a b  instance IfB D    where     ifB x a b = case x of         PrimBoolD c -> if c then a else b-        _              -> on3 ifB x a b+        _              -> on3 (ifExp IfIr) x a b  instance IfB Tab  where     ifB x a b = case x of         PrimBoolD c -> if c then a else b-        _              -> on3 ifB x a b+        _              -> on3 (ifExp IfIr) x a b  instance IfB Str  where     ifB x a b = case x of         PrimBoolD c -> if c then a else b-        _              -> on3 ifB x a b+        _              -> on3 (ifExp IfIr) x a b  instance IfB Spec where     ifB x a b = case x of         PrimBoolD c -> if c then a else b-        _           -> on3 ifB x a b+        _           -> on3 (ifExp IfIr) x a b  instance EqB Sig  where { (==*) = op2 (==) (==*);    (/=*) = op2 (/=) (/=*) } instance EqB D    where { (==*) = op2 (==) (==*);    (/=*) = op2 (/=) (/=*) }@@ -656,108 +659,59 @@ instance OrdB Sig where { (<*)  = op2 (<) (<*) ;    (>*)  = op2 (>) (>*);     (<=*) = op2 (<=) (<=*);    (>=*) = op2 (>=) (>=*) } instance OrdB D   where { (<*)  = op2 (<) (<*) ;    (>*)  = op2 (>) (>*);     (<=*) = op2 (<=) (<=*);    (>=*) = op2 (>=) (>=*) } +-- | Constructs generic if-block statement with single then case+-- We can choose constructors for: if, while, until statements+ifBlockBy :: Val cond => (E -> DepT GE (CodeBlock E) -> DepT GE ()) -> cond -> SE () -> SE ()+ifBlockBy cons p body =+  fromDep_ $ do+    pE <- lift $ toGE p+    cons pE (toBlock $ unSE body)+ -- | Invokes the given procedure if the boolean signal is true. when1 :: BoolSig -> SE () -> SE () when1 xp body = case xp of     PrimBoolSig p -> if p then body else return ()-    _             -> do-        ifBegin xp-        body-        ifEnd+    _             -> ifBlockBy (D.when1 IfKr) xp body  -- | The chain of @when1@s. Tests all the conditions in sequence -- if everything is false it invokes the procedure given in the second argument. whens :: [(BoolSig, SE ())] -> SE () -> SE () whens bodies el = case bodies of     []   -> el-    a:as -> do-        ifBegin (fst a)-        snd a-        elseIfs as-        elseBegin-        el-        foldl1 (>>) $ replicate (length bodies) ifEnd-    where elseIfs = mapM_ (\(p, body) -> elseBegin >> ifBegin p >> body)--ifBegin :: BoolSig -> SE ()-ifBegin a = fromDep_ $ D.ifBegin Kr =<< lift (toGE a)--ifEnd :: SE ()-ifEnd = fromDep_ D.ifEnd--elseBegin :: SE ()-elseBegin = fromDep_ D.elseBegin+    _    -> fromDep_ $ join $ lift $ do+        checksE <- mapM (toGE . fst) bodies+        let bodiesE = fmap (toBlock . unSE . snd) bodies+            elE = toBlock $ unSE el+        pure $ D.whens IfKr (zip checksE bodiesE) elE  -- | Invokes the given procedure if the boolean signal is true. whenD1 :: BoolD -> SE () -> SE () whenD1 xp body = case xp of     PrimBoolD p -> if p then body else return ()-    _             -> do-        ifBeginD xp-        body-        ifEnd+    _           -> ifBlockBy (D.when1 IfIr) xp body  -- | The chain of @when1@s. Tests all the conditions in sequence -- if everything is false it invokes the procedure given in the second argument. whenDs :: [(BoolD, SE ())] -> SE () -> SE () whenDs bodies el = case bodies of     []   -> el-    a:as -> do-        ifBeginD (fst a)-        snd a-        elseIfs as-        elseBegin-        el-        foldl1 (>>) $ replicate (length bodies) ifEnd-    where elseIfs = mapM_ (\(p, body) -> elseBegin >> ifBeginD p >> body)--ifBeginD :: BoolD -> SE ()-ifBeginD a = fromDep_ $ D.ifBegin Ir =<< lift (toGE a)---- elseIfBegin :: BoolSig -> SE ()--- elseIfBegin a = fromDep_ $ D.elseIfBegin =<< lift (toGE a)+    _    -> fromDep_ $ join $ lift $ do+        checksE <- mapM (toGE . fst) bodies+        let bodiesE = fmap (toBlock . unSE . snd) bodies+            elE = toBlock $ unSE el+        pure $ D.whens IfIr (zip checksE bodiesE) elE  untilDo :: BoolSig -> SE () -> SE ()-untilDo p body = do-    untilBegin p-    body-    untilEnd+untilDo = ifBlockBy (D.untilBlock IfKr)  whileDo :: BoolSig -> SE () -> SE ()-whileDo p body = do-    whileBegin p-    body-    whileEnd--whileBegin :: BoolSig -> SE ()-whileBegin a = fromDep_ $ D.whileBegin =<< lift (toGE a)--whileEnd :: SE ()-whileEnd = fromDep_ D.whileEnd--untilBegin :: BoolSig -> SE ()-untilBegin a = fromDep_ $ D.untilBegin =<< lift (toGE a)--untilEnd :: SE ()-untilEnd = fromDep_ D.untilEnd+whileDo = ifBlockBy (D.whileBlock IfKr)  untilDoD :: BoolD -> SE () -> SE ()-untilDoD p body = do-    untilBeginD p-    body-    untilEnd+untilDoD = ifBlockBy (D.untilBlock IfIr)  whileDoD :: BoolD -> SE () -> SE ()-whileDoD p body = do-    whileBeginD p-    body-    whileEnd--whileBeginD :: BoolD -> SE ()-whileBeginD a = fromDep_ $ D.whileBegin =<< lift (toGE a)--untilBeginD :: BoolD -> SE ()-untilBeginD a = fromDep_ $ D.untilBegin =<< lift (toGE a)+whileDoD = ifBlockBy (D.whileBlock IfIr)  -- | Creates a constant boolean signal. boolSig :: BoolD -> BoolSig

@@ -0,0 +1,70 @@+-- | Pure (read-only) arrays+module Csound.Typed.Types.PureArray+  ( PureArr+  , PureArrD+  , newPureArr+  , newPureArrD+  , readPureArr+  , readPureArrD+  ) where++import Data.List qualified as List+import Data.Proxy++import Csound.Dynamic (E, IfRate (..))+import Csound.Dynamic qualified as D+import Csound.Typed.Types.Prim+import Csound.Typed.Types.Tuple+import Csound.Typed.GlobalState.GE++-- | Pure (read-only) array.+-- We can initialise it and it's a pure value.+-- After initialisation we can read values with lookupPureArr+--+-- This version works on initialisation rate+newtype PureArrD a = PureArrD (GE [E])++-- | Pure (read-only) array.+-- We can initialise it and it's a pure value.+-- After initialisation we can read values with lookupPureArr+--+-- This version works on control rate+newtype PureArr a = PureArr (GE [E])++-----------------------------------------------------------------------------+-- initialization++-- | Inits pure array that can be read at control rate+newPureArr :: Tuple a => [a] -> PureArr a+newPureArr = PureArr . newPureArrBy IfKr++-- | Inits pure array that can be read at initialisation rate+newPureArrD :: Arg a => [a] -> PureArrD a+newPureArrD = PureArrD . newPureArrBy IfKr++newPureArrBy :: forall a . Tuple a => IfRate -> [a] -> GE [E]+newPureArrBy procRate initVals = do+  initPrimVals <- List.transpose <$> mapM fromTuple initVals+  pure $ zipWith (\outRate initPrims -> D.initPureArr outRate procRate initPrims) outRates initPrimVals+  where+    outRates = tupleRates (Proxy @a)++-----------------------------------------------------------------------------+-- read values++readPureArr :: Tuple a => PureArr a -> Sig -> a+readPureArr (PureArr vals) index =+  readPureArrBy IfKr vals (toGE index)++readPureArrD :: Arg a => PureArrD a -> D -> a+readPureArrD (PureArrD vals) index =+  readPureArrBy IfIr vals (toGE index)++readPureArrBy :: forall a . Tuple a => IfRate -> GE [E] -> GE E -> a+readPureArrBy procRate vals index = toTuple $ do+  indexE <- index+  valsE  <- vals+  pure $ zipWith (\outRate arr -> D.readPureArr outRate procRate arr (D.setRate indexRate indexE)) outRates valsE+  where+    indexRate = D.fromIfRate procRate+    outRates = tupleRates (Proxy @a)

@@ -17,6 +17,7 @@ import Control.Applicative import Csound.Typed.Types.Prim import Csound.Typed.GlobalState.SE+import Data.Kind (Type) import Data.NumInstances.Tuple()  -- | A class for easy way to process the outputs of the instruments.@@ -476,7 +477,7 @@ -----------------------------------------------------------------------  class SigSpace b => At a b c where-    type AtOut a b c :: *+    type AtOut a b c :: Type     at :: (a -> b) -> c -> AtOut a b c  instance SigSpace a => At Sig Sig a where

@@ -3,6 +3,9 @@         TypeFamilies,         FlexibleContexts,         FlexibleInstances,+        RankNTypes,+        ScopedTypeVariables,+        InstanceSigs,         CPP #-} module Csound.Typed.Types.Tuple(     -- ** Tuple@@ -34,6 +37,7 @@ import Control.Monad.Trans.Class import Data.Default import Data.Boolean+import Data.Proxy  import Csound.Dynamic import Csound.Typed.Types.Prim@@ -49,8 +53,8 @@ data TupleMethods a = TupleMethods     { fromTuple_  :: a -> GE [E]     , toTuple_    :: GE [E] -> a-    , tupleArity_ :: a -> Int-    , tupleRates_ :: a -> [Rate]+    , tupleArity_ :: Proxy a -> Int+    , tupleRates_ :: Proxy a -> [Rate]     , defTuple_   :: a }  fromTuple :: Tuple a => a -> GE [E]@@ -59,10 +63,10 @@ toTuple :: Tuple a => GE [E] -> a toTuple = toTuple_ tupleMethods -tupleArity :: Tuple a => a -> Int+tupleArity :: Tuple a => Proxy a -> Int tupleArity = tupleArity_ tupleMethods -tupleRates :: Tuple a => a -> [Rate]+tupleRates :: Tuple a => Proxy a -> [Rate] tupleRates = tupleRates_ tupleMethods  defTuple :: Tuple a => a@@ -77,11 +81,13 @@     { fromTuple_  = fromTuple . from     , toTuple_    = to . toTuple     , tupleArity_ = const $ tupleArity $ proxy to-    , tupleRates_ = tupleRates . from+    , tupleRates_ = const $ tupleRates $ proxy to     , defTuple_   = to defTuple }-    where proxy :: (a -> b) -> a-          proxy = undefined+    where+      proxy :: (a -> b) -> Proxy a+      proxy = const Proxy + -- Tuple instances  primTupleMethods :: (Val a, Default a) => Rate -> TupleMethods a@@ -109,20 +115,25 @@ instance Tuple TabList where tupleMethods = primTupleMethods Kr  instance (Tuple a, Tuple b) => Tuple (a, b) where-    tupleMethods = TupleMethods fromTuple' toTuple' tupleArity' tupleRates' defTuple'-        where-            fromTuple' (a, b) = liftA2 (++) (fromTuple a) (fromTuple b)-            tupleArity' x = let (a, b) = proxy x in tupleArity a + tupleArity b-                where proxy :: (a, b) -> (a, b)-                      proxy = const (undefined, undefined)-            toTuple' xs = (a, b)-                where a = toTuple $ fmap (take (tupleArity a)) xs-                      xsb = fmap (drop (tupleArity a)) xs-                      b = toTuple $ fmap (take (tupleArity b)) xsb+    tupleMethods = TupleMethods+        { fromTuple_ = \(a, b) -> liftA2 (++) (fromTuple a) (fromTuple b)+        , tupleArity_ = \x -> let (a, b) = splitProxy x in tupleArity a + tupleArity b+        , toTuple_ = \xs ->+                let a = toTuple $ fmap (take (tupleArity $ proxyAsType a)) xs+                    xsb = fmap (drop (tupleArity $ proxyAsType a)) xs+                    b = toTuple $ fmap (take (tupleArity $ proxyAsType b)) xsb+                in (a, b) -            tupleRates' (a, b) = tupleRates a ++ tupleRates b-            defTuple' = (defTuple, defTuple)+        , tupleRates_ = \x -> let (a, b) = splitProxy x in tupleRates a ++ tupleRates b+        , defTuple_ = (defTuple, defTuple)+        } +proxyAsType :: a -> Proxy a+proxyAsType = const Proxy++splitProxy :: Proxy (a, b) -> (Proxy a, Proxy b)+splitProxy = const (Proxy, Proxy)+ instance (Tuple a, Tuple b, Tuple c) => Tuple (a, b, c) where tupleMethods = makeTupleMethods cons3 split3 instance (Tuple a, Tuple b, Tuple c, Tuple d) => Tuple (a, b, c, d) where tupleMethods = makeTupleMethods cons4 split4 instance (Tuple a, Tuple b, Tuple c, Tuple d, Tuple e) => Tuple (a, b, c, d, e) where tupleMethods = makeTupleMethods cons5 split5@@ -133,9 +144,9 @@ ------------------------------------------------------------------------------- -- multiple outs -multiOuts :: Tuple a => E -> a-multiOuts expr = res-    where res = toTuple $ return $ mo (tupleArity res) expr+multiOuts :: forall a . Tuple a => E -> a+multiOuts expr =+  toTuple $ return $ mo (tupleArity (Proxy :: Proxy a)) expr  ar1 :: Sig -> Sig ar2 :: (Sig, Sig) -> (Sig, Sig)@@ -178,11 +189,8 @@ instance Sig2s Sig6 instance Sig2s Sig8 -outArity :: Tuple a => SE a -> Int-outArity = tupleArity . proxy-    where-        proxy :: SE a -> a-        proxy = const undefined+outArity :: forall a . Tuple a => SE a -> Int+outArity = const $ tupleArity (Proxy :: Proxy a)  --------------------------------------------------------------------------- -- Arguments@@ -209,11 +217,11 @@ toArg :: Arg a => a toArg = arg 4 -argArity :: Arg a => a -> Int-argArity = tupleArity+argArity :: forall a . Arg a => a -> Int+argArity = const (tupleArity (Proxy :: Proxy a)) -toNote :: Arg a => a -> GE [E]-toNote a = zipWithM phi (tupleRates a) =<< fromTuple a+toNote :: forall a . Arg a => a -> GE [E]+toNote a = zipWithM phi (tupleRates (Proxy :: Proxy a)) =<< fromTuple a     where         phi rate x = case rate of             Sr -> saveStr $ getStringUnsafe x@@ -240,7 +248,7 @@  instance IfB BoolTuple where     ifB mp (BoolTuple mas) (BoolTuple mbs) = BoolTuple $-        liftA3 (\p as bs -> zipWith (ifB p) as bs) (toGE mp) mas mbs+        liftA3 (\p as bs -> zipWith (ifExp IfKr p) as bs) (toGE mp) mas mbs  -- | @ifB@ for tuples of csound values. ifTuple :: (Tuple a) => BoolSig -> a -> a -> a@@ -258,42 +266,40 @@  newtype BoolArg = BoolArg { unBoolArg :: GE [E] } -toBoolArg :: (Arg a, Tuple a) => a -> BoolArg+toBoolArg :: (Tuple a) => a -> BoolArg toBoolArg   = BoolArg . fromTuple -fromBoolArg :: (Arg a, Tuple a) => BoolArg -> a+fromBoolArg :: (Tuple a) => BoolArg -> a fromBoolArg = toTuple . unBoolArg -type instance BooleanOf BoolArg = BoolD+type instance BooleanOf BoolArg = BoolSig  instance IfB BoolArg where     ifB mp (BoolArg mas) (BoolArg mbs) = BoolArg $-        liftA3 (\p as bs -> zipWith (ifB p) as bs) (toGE mp) mas mbs+        liftA3 (\p as bs -> zipWith (ifExp IfKr p) as bs) (toGE mp) mas mbs  -- | @ifB@ for constants.-ifArg :: (Arg a, Tuple a) => BoolD -> a -> a -> a+ifArg :: (Arg a, Tuple a) => BoolSig -> a -> a -> a ifArg p a b = fromBoolArg $ ifB p (toBoolArg a) (toBoolArg b)  -- | @guardedB@ for constants.-guardedArg :: (Tuple b, Arg b) => [(BoolD, b)] -> b -> b+guardedArg :: (Tuple b) => [(BoolSig, b)] -> b -> b guardedArg bs b = fromBoolArg $ guardedB undefined (fmap (second toBoolArg) bs) (toBoolArg b)  -- | @caseB@ for constants.-caseArg :: (Tuple b, Arg b) => a -> [(a -> BoolD, b)] -> b -> b+caseArg :: (Tuple b, Arg b) => a -> [(a -> BoolSig, b)] -> b -> b caseArg a bs other = fromBoolArg $ caseB a (fmap (second toBoolArg) bs) (toBoolArg other)  ----------------------------------------------------------- -- tuple constructors -pureTuple :: Tuple a => GE (MultiOut [E]) -> a-pureTuple a = res-    where res = toTuple $ fmap ($ tupleArity res) a+pureTuple :: forall a . Tuple a => GE (MultiOut [E]) -> a+pureTuple a =+  toTuple $ fmap ($ tupleArity (Proxy :: Proxy a)) a -dirtyTuple :: Tuple a => GE (MultiOut [E]) -> SE a-dirtyTuple a = res-    where-        res = fmap (toTuple . return) $ SE-                $ mapM depT =<< (lift $ fmap ($ (tupleArity $ proxy res)) a) -        proxy :: SE a -> a-        proxy = const undefined+dirtyTuple :: forall a . Tuple a => GE (MultiOut [E]) -> SE a+dirtyTuple a =+  fmap (toTuple . return) $ SE+    $ mapM depT =<< (lift $ fmap ($ (tupleArity (Proxy :: Proxy a))) a)+