module Csound.Typed.Types.Lift(
GE, E,
PureSingle, pureSingle,
DirtySingle, dirtySingle,
Procedure, procedure,
PureMulti, Pm, fromPm, pureMulti,
DirtyMulti, Dm, fromDm, dirtyMulti
) where
import Control.Applicative
import Csound.Dynamic
import Csound.Typed.Types.Prim
import Csound.Typed.Types.Tuple
import Csound.Typed.GlobalState
pureSingle :: PureSingle a => ([E] -> E) -> a
pureSingle = pureSingleGE . return
dirtySingle :: DirtySingle a => ([E] -> Dep E) -> a
dirtySingle = dirtySingleGE . return
procedure :: Procedure a => ([E] -> Dep ()) -> a
procedure = procedureGE . return
newtype Pm = Pm (GE (MultiOut [E]))
pureMulti :: PureMulti a => ([E] -> MultiOut [E]) -> a
pureMulti = pureMultiGE . return
newtype Dm = Dm (GE (MultiOut (Dep [E])))
dirtyMulti :: DirtyMulti a => ([E] -> MultiOut (Dep [E])) -> a
dirtyMulti = dirtyMultiGE . return
class PureSingle a where
pureSingleGE :: GE ([E] -> E) -> a
class DirtySingle a where
dirtySingleGE :: GE ([E] -> Dep E) -> a
class Procedure a where
procedureGE :: GE ([E] -> Dep ()) -> a
class PureMulti a where
pureMultiGE :: GE ([E] -> MultiOut [E]) -> a
class DirtyMulti a where
dirtyMultiGE :: GE ([E] -> MultiOut (Dep [E])) -> a
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
proxy :: SE a -> a
proxy = const undefined
instance PureSingle (GE E) where
pureSingleGE = fmap ($ [])
instance PureSingle b => PureSingle (GE E -> b) where
pureSingleGE mf = \ma -> pureSingleGE $ (\f a as -> f (a:as)) <$> mf <*> ma
instance PureSingle b => PureSingle (GE [E] -> b) where
pureSingleGE mf = \mas -> pureSingleGE $ (\f as bs -> f (as ++ bs)) <$> mf <*> mas
ps0 :: (Val a) => GE ([E] -> E) -> a
ps0 = fromGE . pureSingleGE
ps1 :: (Val a, PureSingle b) => GE ([E] -> E) -> (a -> b)
ps1 f = pureSingleGE f . toGE
pss :: (Val a, PureSingle b) => GE ([E] -> E) -> ([a] -> b)
pss f = pureSingleGE f . mapM toGE
instance PureSingle Sig where pureSingleGE = ps0
instance PureSingle D where pureSingleGE = ps0
instance PureSingle Str where pureSingleGE = ps0
instance PureSingle Tab where pureSingleGE = ps0
instance PureSingle Spec where pureSingleGE = ps0
instance PureSingle Wspec where pureSingleGE = ps0
instance (PureSingle b) => PureSingle (Sig -> b) where pureSingleGE = ps1
instance (PureSingle b) => PureSingle (D -> b) where pureSingleGE = ps1
instance (PureSingle b) => PureSingle (Str -> b) where pureSingleGE = ps1
instance (PureSingle b) => PureSingle (Tab -> b) where pureSingleGE = ps1
instance (PureSingle b) => PureSingle (Spec -> b) where pureSingleGE = ps1
instance (PureSingle b) => PureSingle (Wspec -> b) where pureSingleGE = ps1
instance (PureSingle b) => PureSingle ([Sig] -> b) where pureSingleGE = pss
instance (PureSingle b) => PureSingle ([D] -> b) where pureSingleGE = pss
instance (PureSingle b) => PureSingle (Msg -> b) where pureSingleGE f = const $ pureSingleGE f
instance DirtySingle (SE (GE E)) where
dirtySingleGE = fromDep . hideGEinDep . fmap ($ [])
instance DirtySingle b => DirtySingle (GE E -> b) where
dirtySingleGE mf = \ma -> dirtySingleGE $ (\f a as -> f (a:as)) <$> mf <*> ma
instance DirtySingle b => DirtySingle (GE [E] -> b) where
dirtySingleGE mf = \mas -> dirtySingleGE $ (\f as bs -> f (as ++ bs)) <$> mf <*> mas
ds0 :: (Val a) => GE ([E] -> Dep E) -> SE a
ds0 = fmap fromGE . dirtySingleGE
ds1 :: (Val a, DirtySingle b) => GE ([E] -> Dep E) -> (a -> b)
ds1 f = dirtySingleGE f . toGE
dss :: (Val a, DirtySingle b) => GE ([E] -> Dep E) -> ([a] -> b)
dss f = dirtySingleGE f . mapM toGE
instance DirtySingle (SE Sig) where dirtySingleGE = ds0
instance DirtySingle (SE D) where dirtySingleGE = ds0
instance DirtySingle (SE Str) where dirtySingleGE = ds0
instance DirtySingle (SE Tab) where dirtySingleGE = ds0
instance DirtySingle (SE Spec) where dirtySingleGE = ds0
instance DirtySingle (SE Wspec) where dirtySingleGE = ds0
instance (DirtySingle b) => DirtySingle (Sig -> b) where dirtySingleGE = ds1
instance (DirtySingle b) => DirtySingle (D -> b) where dirtySingleGE = ds1
instance (DirtySingle b) => DirtySingle (Str -> b) where dirtySingleGE = ds1
instance (DirtySingle b) => DirtySingle (Tab -> b) where dirtySingleGE = ds1
instance (DirtySingle b) => DirtySingle (Spec -> b) where dirtySingleGE = ds1
instance (DirtySingle b) => DirtySingle (Wspec -> b) where dirtySingleGE = ds1
instance (DirtySingle b) => DirtySingle ([Sig] -> b) where dirtySingleGE = dss
instance (DirtySingle b) => DirtySingle ([D] -> b) where dirtySingleGE = dss
instance (DirtySingle b) => DirtySingle (Msg -> b) where dirtySingleGE f = const $ dirtySingleGE f
instance Procedure (SE ()) where
procedureGE = fromDep_ . hideGEinDep . fmap ($ [])
instance Procedure b => Procedure (GE E -> b) where
procedureGE mf = \ma -> procedureGE $ (\f a as -> f (a:as)) <$> mf <*> ma
instance Procedure b => Procedure (GE [E] -> b) where
procedureGE mf = \mas -> procedureGE $ (\f as bs -> f (as ++ bs)) <$> mf <*> mas
pr1 :: (Val a, Procedure b) => GE ([E] -> Dep ()) -> a -> b
pr1 f = procedureGE f . toGE
prs :: (Val a, Procedure b) => GE ([E] -> Dep ()) -> ([a] -> b)
prs f = procedureGE f . mapM toGE
instance (Procedure b) => Procedure (Sig -> b) where procedureGE = pr1
instance (Procedure b) => Procedure (D -> b) where procedureGE = pr1
instance (Procedure b) => Procedure (Str -> b) where procedureGE = pr1
instance (Procedure b) => Procedure (Tab -> b) where procedureGE = pr1
instance (Procedure b) => Procedure (Spec -> b) where procedureGE = pr1
instance (Procedure b) => Procedure (Wspec -> b) where procedureGE = pr1
instance (Procedure b) => Procedure ([Sig] -> b) where procedureGE = prs
instance (Procedure b) => Procedure ([D] -> b) where procedureGE = prs
instance (Procedure b) => Procedure (Msg -> b) where procedureGE f = const $ procedureGE f
instance PureMulti Pm where
pureMultiGE = Pm . fmap ($ [])
instance PureMulti b => PureMulti (GE E -> b) where
pureMultiGE mf = \ma -> pureMultiGE $ (\f a as -> f (a:as)) <$> mf <*> ma
instance PureMulti b => PureMulti (GE [E] -> b) where
pureMultiGE mf = \mas -> pureMultiGE $ (\f as bs -> f (as ++ bs)) <$> mf <*> mas
pm1 :: (Val a, PureMulti b) => GE ([E] -> MultiOut [E]) -> (a -> b)
pm1 f = pureMultiGE f . toGE
pms :: (Val a, PureMulti b) => GE ([E] -> MultiOut [E]) -> ([a] -> b)
pms f = pureMultiGE f . mapM toGE
instance (PureMulti b) => PureMulti (Sig -> b) where pureMultiGE = pm1
instance (PureMulti b) => PureMulti (D -> b) where pureMultiGE = pm1
instance (PureMulti b) => PureMulti (Str -> b) where pureMultiGE = pm1
instance (PureMulti b) => PureMulti (Tab -> b) where pureMultiGE = pm1
instance (PureMulti b) => PureMulti (Spec -> b) where pureMultiGE = pm1
instance (PureMulti b) => PureMulti (Wspec -> b) where pureMultiGE = pm1
instance (PureMulti b) => PureMulti ([Sig] -> b) where pureMultiGE = pms
instance (PureMulti b) => PureMulti ([D] -> b) where pureMultiGE = pms
instance (PureMulti b) => PureMulti (Msg -> b) where pureMultiGE f = const $ pureMultiGE f
instance DirtyMulti Dm where
dirtyMultiGE = Dm . fmap ($ [])
instance DirtyMulti b => DirtyMulti (GE E -> b) where
dirtyMultiGE mf = \ma -> dirtyMultiGE $ (\f a as -> f (a:as)) <$> mf <*> ma
instance DirtyMulti b => DirtyMulti (GE [E] -> b) where
dirtyMultiGE mf = \mas -> dirtyMultiGE $ (\f as bs -> f (as ++ bs)) <$> mf <*> mas
dm1 :: (Val a, DirtyMulti b) => GE ([E] -> MultiOut (Dep [E])) -> (a -> b)
dm1 f = dirtyMultiGE f . toGE
dms :: (Val a, DirtyMulti b) => GE ([E] -> MultiOut (Dep [E])) -> ([a] -> b)
dms f = dirtyMultiGE f . mapM toGE
instance (DirtyMulti b) => DirtyMulti (Sig -> b) where dirtyMultiGE = dm1
instance (DirtyMulti b) => DirtyMulti (D -> b) where dirtyMultiGE = dm1
instance (DirtyMulti b) => DirtyMulti (Str -> b) where dirtyMultiGE = dm1
instance (DirtyMulti b) => DirtyMulti (Tab -> b) where dirtyMultiGE = dm1
instance (DirtyMulti b) => DirtyMulti (Spec -> b) where dirtyMultiGE = dm1
instance (DirtyMulti b) => DirtyMulti (Wspec -> b) where dirtyMultiGE = dm1
instance (DirtyMulti b) => DirtyMulti ([Sig] -> b) where dirtyMultiGE = dms
instance (DirtyMulti b) => DirtyMulti ([D] -> b) where dirtyMultiGE = dms
instance (DirtyMulti b) => DirtyMulti (Msg -> b) where dirtyMultiGE f = const $ dirtyMultiGE f