{-# LANGUAGE DeriveFunctor #-}
module Instrument.Common where
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Util.Doc as Doc
import qualified Util.Lens as Lens
import qualified Util.Pretty as Pretty
import qualified Util.Seq as Seq
import qualified Util.Serialize as Serialize
import qualified Derive.Attrs as Attrs
import qualified Derive.EnvKey as EnvKey
import qualified Derive.Expr as Expr
import qualified Derive.REnv as REnv
import qualified Derive.ScoreT as ScoreT
import qualified Derive.ShowVal as ShowVal
import qualified Instrument.Tag as Tag
import Global
data Common code = Common {
forall code. Common code -> code
common_code :: !code
, forall code. Common code -> Environ
common_environ :: !REnv.Environ
, forall code. Common code -> [Tag]
common_tags :: ![Tag.Tag]
, forall code. Common code -> Doc
common_doc :: !Doc.Doc
, forall code. Common code -> Set Flag
common_flags :: !(Set Flag)
, forall code. Common code -> CallMap
common_call_map :: !CallMap
} deriving (Int -> Common code -> ShowS
[Common code] -> ShowS
Common code -> String
(Int -> Common code -> ShowS)
-> (Common code -> String)
-> ([Common code] -> ShowS)
-> Show (Common code)
forall code. Show code => Int -> Common code -> ShowS
forall code. Show code => [Common code] -> ShowS
forall code. Show code => Common code -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Common code] -> ShowS
$cshowList :: forall code. Show code => [Common code] -> ShowS
show :: Common code -> String
$cshow :: forall code. Show code => Common code -> String
showsPrec :: Int -> Common code -> ShowS
$cshowsPrec :: forall code. Show code => Int -> Common code -> ShowS
Show, (forall a b. (a -> b) -> Common a -> Common b)
-> (forall a b. a -> Common b -> Common a) -> Functor Common
forall a b. a -> Common b -> Common a
forall a b. (a -> b) -> Common a -> Common b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Common b -> Common a
$c<$ :: forall a b. a -> Common b -> Common a
fmap :: forall a b. (a -> b) -> Common a -> Common b
$cfmap :: forall a b. (a -> b) -> Common a -> Common b
Functor)
code :: Common code :-> code
code = (Common code -> code)
-> ((code -> code) -> Common code -> Common code)
-> Common code :-> code
forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Common code -> code
forall code. Common code -> code
common_code (\code -> code
f Common code
r -> Common code
r { common_code :: code
common_code = code -> code
f (Common code -> code
forall code. Common code -> code
common_code Common code
r) })
environ :: Common code :-> Environ
environ = (Common code -> Environ)
-> ((Environ -> Environ) -> Common code -> Common code)
-> Common code :-> Environ
forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Common code -> Environ
forall code. Common code -> Environ
common_environ
(\Environ -> Environ
f Common code
r -> Common code
r { common_environ :: Environ
common_environ = Environ -> Environ
f (Common code -> Environ
forall code. Common code -> Environ
common_environ Common code
r) })
tags :: Common code :-> [Tag]
tags = (Common code -> [Tag])
-> (([Tag] -> [Tag]) -> Common code -> Common code)
-> Common code :-> [Tag]
forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Common code -> [Tag]
forall code. Common code -> [Tag]
common_tags (\[Tag] -> [Tag]
f Common code
r -> Common code
r { common_tags :: [Tag]
common_tags = [Tag] -> [Tag]
f (Common code -> [Tag]
forall code. Common code -> [Tag]
common_tags Common code
r) })
doc :: Common code :-> Doc
doc = (Common code -> Doc)
-> ((Doc -> Doc) -> Common code -> Common code)
-> Common code :-> Doc
forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Common code -> Doc
forall code. Common code -> Doc
common_doc (\Doc -> Doc
f Common code
r -> Common code
r { common_doc :: Doc
common_doc = Doc -> Doc
f (Common code -> Doc
forall code. Common code -> Doc
common_doc Common code
r) })
flags :: Common code :-> Set Flag
flags = (Common code -> Set Flag)
-> ((Set Flag -> Set Flag) -> Common code -> Common code)
-> Common code :-> Set Flag
forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Common code -> Set Flag
forall code. Common code -> Set Flag
common_flags (\Set Flag -> Set Flag
f Common code
r -> Common code
r { common_flags :: Set Flag
common_flags = Set Flag -> Set Flag
f (Common code -> Set Flag
forall code. Common code -> Set Flag
common_flags Common code
r) })
call_map :: Common code :-> CallMap
call_map = (Common code -> CallMap)
-> ((CallMap -> CallMap) -> Common code -> Common code)
-> Common code :-> CallMap
forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Common code -> CallMap
forall code. Common code -> CallMap
common_call_map
(\CallMap -> CallMap
f Common code
r -> Common code
r { common_call_map :: CallMap
common_call_map = CallMap -> CallMap
f (Common code -> CallMap
forall code. Common code -> CallMap
common_call_map Common code
r) })
type CallMap = Map Attrs.Attributes Expr.Symbol
common :: code -> Common code
common :: forall code. code -> Common code
common code
code = Common
{ common_code :: code
common_code = code
code
, common_environ :: Environ
common_environ = Environ
forall a. Monoid a => a
mempty
, common_tags :: [Tag]
common_tags = []
, common_doc :: Doc
common_doc = Doc
""
, common_flags :: Set Flag
common_flags = Set Flag
forall a. Monoid a => a
mempty
, common_call_map :: CallMap
common_call_map = CallMap
forall a. Monoid a => a
mempty
}
instance Pretty code => Pretty (Common code) where
format :: Common code -> Doc
format (Common code
code Environ
env [Tag]
tags Doc
doc Set Flag
flags CallMap
call_map) =
Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"Instrument"
[ (Text
"code", code -> Doc
forall a. Pretty a => a -> Doc
Pretty.format code
code)
, (Text
"restricted_environ", Environ -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Environ
env)
, (Text
"tags", [Tag] -> Doc
forall a. Pretty a => a -> Doc
Pretty.format [Tag]
tags)
, (Text
"doc", Doc -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Doc
doc)
, (Text
"flags", Set Flag -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Set Flag
flags)
, (Text
"call_map", CallMap -> Doc
forall a. Pretty a => a -> Doc
Pretty.format CallMap
call_map)
]
data Flag =
Triggered
deriving (Flag -> Flag -> Bool
(Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> Eq Flag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c== :: Flag -> Flag -> Bool
Eq, Eq Flag
Eq Flag
-> (Flag -> Flag -> Ordering)
-> (Flag -> Flag -> Bool)
-> (Flag -> Flag -> Bool)
-> (Flag -> Flag -> Bool)
-> (Flag -> Flag -> Bool)
-> (Flag -> Flag -> Flag)
-> (Flag -> Flag -> Flag)
-> Ord Flag
Flag -> Flag -> Bool
Flag -> Flag -> Ordering
Flag -> Flag -> Flag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Flag -> Flag -> Flag
$cmin :: Flag -> Flag -> Flag
max :: Flag -> Flag -> Flag
$cmax :: Flag -> Flag -> Flag
>= :: Flag -> Flag -> Bool
$c>= :: Flag -> Flag -> Bool
> :: Flag -> Flag -> Bool
$c> :: Flag -> Flag -> Bool
<= :: Flag -> Flag -> Bool
$c<= :: Flag -> Flag -> Bool
< :: Flag -> Flag -> Bool
$c< :: Flag -> Flag -> Bool
compare :: Flag -> Flag -> Ordering
$ccompare :: Flag -> Flag -> Ordering
Ord, Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> String
(Int -> Flag -> ShowS)
-> (Flag -> String) -> ([Flag] -> ShowS) -> Show Flag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flag] -> ShowS
$cshowList :: [Flag] -> ShowS
show :: Flag -> String
$cshow :: Flag -> String
showsPrec :: Int -> Flag -> ShowS
$cshowsPrec :: Int -> Flag -> ShowS
Show, Int -> Flag
Flag -> Int
Flag -> [Flag]
Flag -> Flag
Flag -> Flag -> [Flag]
Flag -> Flag -> Flag -> [Flag]
(Flag -> Flag)
-> (Flag -> Flag)
-> (Int -> Flag)
-> (Flag -> Int)
-> (Flag -> [Flag])
-> (Flag -> Flag -> [Flag])
-> (Flag -> Flag -> [Flag])
-> (Flag -> Flag -> Flag -> [Flag])
-> Enum Flag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Flag -> Flag -> Flag -> [Flag]
$cenumFromThenTo :: Flag -> Flag -> Flag -> [Flag]
enumFromTo :: Flag -> Flag -> [Flag]
$cenumFromTo :: Flag -> Flag -> [Flag]
enumFromThen :: Flag -> Flag -> [Flag]
$cenumFromThen :: Flag -> Flag -> [Flag]
enumFrom :: Flag -> [Flag]
$cenumFrom :: Flag -> [Flag]
fromEnum :: Flag -> Int
$cfromEnum :: Flag -> Int
toEnum :: Int -> Flag
$ctoEnum :: Int -> Flag
pred :: Flag -> Flag
$cpred :: Flag -> Flag
succ :: Flag -> Flag
$csucc :: Flag -> Flag
Enum, Flag
Flag -> Flag -> Bounded Flag
forall a. a -> a -> Bounded a
maxBound :: Flag
$cmaxBound :: Flag
minBound :: Flag
$cminBound :: Flag
Bounded)
instance Pretty Flag where pretty :: Flag -> Text
pretty = Flag -> Text
forall a. Show a => a -> Text
showt
add_environ :: REnv.ToVal a => EnvKey.Key -> a
-> Common code -> Common code
add_environ :: forall a code. ToVal a => Text -> a -> Common code -> Common code
add_environ Text
key a
val =
Common code :-> Environ
forall {code}. Common code :-> Environ
environ (Common code :-> Environ)
-> (Environ -> Environ) -> Common code -> Common code
forall f a. Lens f a -> (a -> a) -> f -> f
%= ([(Text, Val)] -> Environ
REnv.from_list [(Text
key, a -> Val
forall a. ToVal a => a -> Val
REnv.to_val a
val)] <>)
newtype AttributeMap a = AttributeMap [(Attrs.Attributes, a)]
deriving (AttributeMap a -> AttributeMap a -> Bool
(AttributeMap a -> AttributeMap a -> Bool)
-> (AttributeMap a -> AttributeMap a -> Bool)
-> Eq (AttributeMap a)
forall a. Eq a => AttributeMap a -> AttributeMap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeMap a -> AttributeMap a -> Bool
$c/= :: forall a. Eq a => AttributeMap a -> AttributeMap a -> Bool
== :: AttributeMap a -> AttributeMap a -> Bool
$c== :: forall a. Eq a => AttributeMap a -> AttributeMap a -> Bool
Eq, Int -> AttributeMap a -> ShowS
[AttributeMap a] -> ShowS
AttributeMap a -> String
(Int -> AttributeMap a -> ShowS)
-> (AttributeMap a -> String)
-> ([AttributeMap a] -> ShowS)
-> Show (AttributeMap a)
forall a. Show a => Int -> AttributeMap a -> ShowS
forall a. Show a => [AttributeMap a] -> ShowS
forall a. Show a => AttributeMap a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeMap a] -> ShowS
$cshowList :: forall a. Show a => [AttributeMap a] -> ShowS
show :: AttributeMap a -> String
$cshow :: forall a. Show a => AttributeMap a -> String
showsPrec :: Int -> AttributeMap a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AttributeMap a -> ShowS
Show, [AttributeMap a] -> Doc
AttributeMap a -> Text
AttributeMap a -> Doc
(AttributeMap a -> Text)
-> (AttributeMap a -> Doc)
-> ([AttributeMap a] -> Doc)
-> Pretty (AttributeMap a)
forall a. Pretty a => [AttributeMap a] -> Doc
forall a. Pretty a => AttributeMap a -> Text
forall a. Pretty a => AttributeMap a -> Doc
forall a. (a -> Text) -> (a -> Doc) -> ([a] -> Doc) -> Pretty a
formatList :: [AttributeMap a] -> Doc
$cformatList :: forall a. Pretty a => [AttributeMap a] -> Doc
format :: AttributeMap a -> Doc
$cformat :: forall a. Pretty a => AttributeMap a -> Doc
pretty :: AttributeMap a -> Text
$cpretty :: forall a. Pretty a => AttributeMap a -> Text
Pretty, (forall a b. (a -> b) -> AttributeMap a -> AttributeMap b)
-> (forall a b. a -> AttributeMap b -> AttributeMap a)
-> Functor AttributeMap
forall a b. a -> AttributeMap b -> AttributeMap a
forall a b. (a -> b) -> AttributeMap a -> AttributeMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> AttributeMap b -> AttributeMap a
$c<$ :: forall a b. a -> AttributeMap b -> AttributeMap a
fmap :: forall a b. (a -> b) -> AttributeMap a -> AttributeMap b
$cfmap :: forall a b. (a -> b) -> AttributeMap a -> AttributeMap b
Functor, Get (AttributeMap a)
Putter (AttributeMap a)
Putter (AttributeMap a)
-> Get (AttributeMap a) -> Serialize (AttributeMap a)
forall a. Serialize a => Get (AttributeMap a)
forall a. Serialize a => Putter (AttributeMap a)
forall a. Putter a -> Get a -> Serialize a
get :: Get (AttributeMap a)
$cget :: forall a. Serialize a => Get (AttributeMap a)
put :: Putter (AttributeMap a)
$cput :: forall a. Serialize a => Putter (AttributeMap a)
Serialize.Serialize)
instance Semigroup (AttributeMap a) where
AttributeMap [(Attributes, a)]
as <> :: AttributeMap a -> AttributeMap a -> AttributeMap a
<> AttributeMap [(Attributes, a)]
bs =
[(Attributes, a)] -> AttributeMap a
forall a. [(Attributes, a)] -> AttributeMap a
AttributeMap ([(Attributes, a)] -> AttributeMap a)
-> [(Attributes, a)] -> AttributeMap a
forall a b. (a -> b) -> a -> b
$ [(Attributes, a)] -> [(Attributes, a)]
forall a. [(Attributes, a)] -> [(Attributes, a)]
sort_attributes ([(Attributes, a)]
as [(Attributes, a)] -> [(Attributes, a)] -> [(Attributes, a)]
forall a. Semigroup a => a -> a -> a
<> [(Attributes, a)]
bs)
instance Monoid (AttributeMap a) where
mempty :: AttributeMap a
mempty = [(Attributes, a)] -> AttributeMap a
forall a. [(Attributes, a)] -> AttributeMap a
AttributeMap []
mappend :: AttributeMap a -> AttributeMap a -> AttributeMap a
mappend = AttributeMap a -> AttributeMap a -> AttributeMap a
forall a. Semigroup a => a -> a -> a
(<>)
attribute_map :: [(Attrs.Attributes, a)] -> AttributeMap a
attribute_map :: forall a. [(Attributes, a)] -> AttributeMap a
attribute_map = [(Attributes, a)] -> AttributeMap a
forall a. [(Attributes, a)] -> AttributeMap a
AttributeMap ([(Attributes, a)] -> AttributeMap a)
-> ([(Attributes, a)] -> [(Attributes, a)])
-> [(Attributes, a)]
-> AttributeMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Attributes, a)] -> [(Attributes, a)]
forall a. [(Attributes, a)] -> [(Attributes, a)]
sort_attributes
mapped_attributes :: AttributeMap a -> [Attrs.Attributes]
mapped_attributes :: forall a. AttributeMap a -> [Attributes]
mapped_attributes (AttributeMap [(Attributes, a)]
table) = ((Attributes, a) -> Attributes)
-> [(Attributes, a)] -> [Attributes]
forall a b. (a -> b) -> [a] -> [b]
map (Attributes, a) -> Attributes
forall a b. (a, b) -> a
fst [(Attributes, a)]
table
attribute_vals :: AttributeMap a -> [a]
attribute_vals :: forall a. AttributeMap a -> [a]
attribute_vals (AttributeMap [(Attributes, a)]
table) = ((Attributes, a) -> a) -> [(Attributes, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Attributes, a) -> a
forall a b. (a, b) -> b
snd [(Attributes, a)]
table
lookup_attributes :: Attrs.Attributes -> AttributeMap a
-> Maybe (Attrs.Attributes, a)
lookup_attributes :: forall a. Attributes -> AttributeMap a -> Maybe (Attributes, a)
lookup_attributes Attributes
attrs (AttributeMap [(Attributes, a)]
table) =
((Attributes, a) -> Bool)
-> [(Attributes, a)] -> Maybe (Attributes, a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((Attributes
attrs `Attrs.contain`) (Attributes -> Bool)
-> ((Attributes, a) -> Attributes) -> (Attributes, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attributes, a) -> Attributes
forall a b. (a, b) -> a
fst) [(Attributes, a)]
table
overlapping_attributes :: AttributeMap a -> [Text]
overlapping_attributes :: forall a. AttributeMap a -> [Text]
overlapping_attributes (AttributeMap [(Attributes, a)]
table) =
[Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
Maybe.catMaybes ([Maybe Text] -> [Text]) -> [Maybe Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ([Attributes] -> Attributes -> Maybe Text)
-> [[Attributes]] -> [Attributes] -> [Maybe Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Attributes] -> Attributes -> Maybe Text
forall {t :: * -> *}.
Foldable t =>
t Attributes -> Attributes -> Maybe Text
check ([Attributes] -> [[Attributes]]
forall a. [a] -> [[a]]
List.inits [Attributes]
attrs) [Attributes]
attrs
where
attrs :: [Attributes]
attrs = ((Attributes, a) -> Attributes)
-> [(Attributes, a)] -> [Attributes]
forall a b. (a -> b) -> [a] -> [b]
map (Attributes, a) -> Attributes
forall a b. (a, b) -> a
fst [(Attributes, a)]
table
check :: t Attributes -> Attributes -> Maybe Text
check t Attributes
prevs Attributes
attr = case (Attributes -> Bool) -> t Attributes -> Maybe Attributes
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Attributes -> Attributes -> Bool
Attrs.contain Attributes
attr) t Attributes
prevs of
Just Attributes
other_attr -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"attrs "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Attributes -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Attributes
attr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" shadowed by "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Attributes -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Attributes
other_attr
Maybe Attributes
Nothing -> Maybe Text
forall a. Maybe a
Nothing
sort_attributes :: [(Attrs.Attributes, a)] -> [(Attrs.Attributes, a)]
sort_attributes :: forall a. [(Attributes, a)] -> [(Attributes, a)]
sort_attributes = ((Attributes, a) -> Int) -> [(Attributes, a)] -> [(Attributes, a)]
forall k a. Ord k => (a -> k) -> [a] -> [a]
Seq.sort_on (\(Attributes
a, a
_) -> - Set Text -> Int
forall a. Set a -> Int
Set.size (Attributes -> Set Text
Attrs.to_set Attributes
a))
data Config = Config {
Config -> Environ
config_environ :: !REnv.Environ
, Config -> ControlValMap
config_controls :: !ScoreT.ControlValMap
, Config -> Bool
config_mute :: !Bool
, Config -> Bool
config_solo :: !Bool
} deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)
empty_config :: Config
empty_config :: Config
empty_config = Config
{ config_environ :: Environ
config_environ = Environ
forall a. Monoid a => a
mempty
, config_controls :: ControlValMap
config_controls = ControlValMap
forall a. Monoid a => a
mempty
, config_mute :: Bool
config_mute = Bool
False
, config_solo :: Bool
config_solo = Bool
False
}
cenviron :: Config :-> Environ
cenviron = (Config -> Environ)
-> ((Environ -> Environ) -> Config -> Config) -> Config :-> Environ
forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Config -> Environ
config_environ
(\Environ -> Environ
f Config
r -> Config
r { config_environ :: Environ
config_environ = Environ -> Environ
f (Config -> Environ
config_environ Config
r) })
controls :: Config :-> ControlValMap
controls = (Config -> ControlValMap)
-> ((ControlValMap -> ControlValMap) -> Config -> Config)
-> Config :-> ControlValMap
forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Config -> ControlValMap
config_controls
(\ControlValMap -> ControlValMap
f Config
r -> Config
r { config_controls :: ControlValMap
config_controls = ControlValMap -> ControlValMap
f (Config -> ControlValMap
config_controls Config
r) })
mute :: Config :-> Bool
mute = (Config -> Bool)
-> ((Bool -> Bool) -> Config -> Config) -> Config :-> Bool
forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Config -> Bool
config_mute
(\Bool -> Bool
f Config
r -> Config
r { config_mute :: Bool
config_mute = Bool -> Bool
f (Config -> Bool
config_mute Config
r) })
solo :: Config :-> Bool
solo = (Config -> Bool)
-> ((Bool -> Bool) -> Config -> Config) -> Config :-> Bool
forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Config -> Bool
config_solo
(\Bool -> Bool
f Config
r -> Config
r { config_solo :: Bool
config_solo = Bool -> Bool
f (Config -> Bool
config_solo Config
r) })
instance Pretty Config where
format :: Config -> Doc
format (Config Environ
environ ControlValMap
controls Bool
mute Bool
solo) = Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"Config"
[ (Text
"environ", Environ -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Environ
environ)
, (Text
"controls", ControlValMap -> Doc
forall a. Pretty a => a -> Doc
Pretty.format ControlValMap
controls)
, (Text
"mute", Bool -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Bool
mute)
, (Text
"solo", Bool -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Bool
solo)
]
add_cenviron :: REnv.ToVal a => EnvKey.Key -> a
-> Config -> Config
add_cenviron :: forall a. ToVal a => Text -> a -> Config -> Config
add_cenviron Text
key a
val = Config :-> Environ
cenviron (Config :-> Environ) -> (Environ -> Environ) -> Config -> Config
forall f a. Lens f a -> (a -> a) -> f -> f
%= ([(Text, Val)] -> Environ
REnv.from_list [(Text
key, Val
v)] <>)
where v :: Val
v = a -> Val
forall a. ToVal a => a -> Val
REnv.to_val a
val