module Derive.Scale.All (lookup_scale, docs, scales, shadowed) where
import qualified Data.Map as Map
import qualified Util.Maps as Maps
import qualified Util.Seq as Seq
import qualified Derive.Derive as Derive
import qualified Derive.Scale as Scale
import qualified Derive.Scale.BohlenPierce as BohlenPierce
import qualified Derive.Scale.Edo as Edo
import qualified Derive.Scale.Harmonic as Harmonic
import qualified Derive.Scale.Hex as Hex
import qualified Derive.Scale.Interpolate as Interpolate
import qualified Derive.Scale.Just as Just
import qualified Derive.Scale.Legong as Legong
import qualified Derive.Scale.Octa as Octa
import qualified Derive.Scale.Raga as Raga
import qualified Derive.Scale.Ratio as Ratio
import qualified Derive.Scale.Selisir as Selisir
import qualified Derive.Scale.Twelve as Twelve
import qualified Derive.Scale.Wayang as Wayang
import qualified Derive.Scale.WendyCarlos as WendyCarlos
import qualified Perform.Pitch as Pitch
import Global
lookup_scale :: Scale.LookupScale
lookup_scale :: LookupScale
lookup_scale = (Environ -> ScaleId -> Maybe (Either PitchError Scale))
-> LookupScale
Scale.LookupScale Environ -> ScaleId -> Maybe (Either PitchError Scale)
lookup
where
lookup :: Environ -> ScaleId -> Maybe (Either PitchError Scale)
lookup Environ
env ScaleId
scale_id = Environ -> Definition -> Either PitchError Scale
make Environ
env (Definition -> Either PitchError Scale)
-> Maybe Definition -> Maybe (Either PitchError Scale)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScaleId -> Map ScaleId Definition -> Maybe Definition
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScaleId
scale_id Map ScaleId Definition
scales
make :: Environ -> Definition -> Either PitchError Scale
make Environ
_ (Scale.Simple Scale
scale) = Scale -> Either PitchError Scale
forall a b. b -> Either a b
Right Scale
scale
make Environ
env (Scale.Make ScaleId
_ (Text, DocumentedCall)
_ Environ -> LookupScale -> Either PitchError Scale
make) = Environ -> LookupScale -> Either PitchError Scale
make Environ
env LookupScale
lookup_scale
docs :: [(Pitch.ScaleId, Text, Derive.DocumentedCall)]
docs :: [(ScaleId, Text, DocumentedCall)]
docs = (Definition -> (ScaleId, Text, DocumentedCall))
-> [Definition] -> [(ScaleId, Text, DocumentedCall)]
forall a b. (a -> b) -> [a] -> [b]
map Definition -> (ScaleId, Text, DocumentedCall)
extract (Map ScaleId Definition -> [Definition]
forall k a. Map k a -> [a]
Map.elems Map ScaleId Definition
scales)
where
extract :: Definition -> (ScaleId, Text, DocumentedCall)
extract (Scale.Simple Scale
scale) = (Scale -> ScaleId
Scale.scale_id Scale
scale,
Scale -> Text
Scale.scale_pattern Scale
scale, Scale -> DocumentedCall
Scale.scale_call_doc Scale
scale)
extract (Scale.Make ScaleId
scale_id (Text
pattern, DocumentedCall
doc) Environ -> LookupScale -> Either PitchError Scale
_) = (ScaleId
scale_id, Text
pattern, DocumentedCall
doc)
scales :: Map Pitch.ScaleId Scale.Definition
shadowed :: [Pitch.ScaleId]
(Map ScaleId Definition
scales, [ScaleId]
shadowed) = [Definition] -> (Map ScaleId Definition, [ScaleId])
mk ([Definition] -> (Map ScaleId Definition, [ScaleId]))
-> [Definition] -> (Map ScaleId Definition, [ScaleId])
forall a b. (a -> b) -> a -> b
$ [[Definition]] -> [Definition]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Definition]
BohlenPierce.scales
, [Definition]
Edo.scales
, [Definition]
Hex.scales
, [Definition]
Interpolate.scales
, [Definition]
Just.scales
, [Definition]
Harmonic.scales
, [Definition]
Legong.scales
, [Definition]
Octa.scales
, [Definition]
Raga.scales
, [Definition]
Ratio.scales
, [Definition]
Selisir.scales
, [Definition]
Twelve.scales
, [Definition]
Wayang.scales
, [Definition]
WendyCarlos.scales
]
where
mk :: [Definition] -> (Map ScaleId Definition, [ScaleId])
mk = ([(ScaleId, Definition)] -> [ScaleId])
-> (Map ScaleId Definition, [(ScaleId, Definition)])
-> (Map ScaleId Definition, [ScaleId])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (((ScaleId, Definition) -> ScaleId)
-> [(ScaleId, Definition)] -> [ScaleId]
forall a b. (a -> b) -> [a] -> [b]
map (ScaleId, Definition) -> ScaleId
forall a b. (a, b) -> a
fst) ((Map ScaleId Definition, [(ScaleId, Definition)])
-> (Map ScaleId Definition, [ScaleId]))
-> ([Definition]
-> (Map ScaleId Definition, [(ScaleId, Definition)]))
-> [Definition]
-> (Map ScaleId Definition, [ScaleId])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ScaleId, Definition)]
-> (Map ScaleId Definition, [(ScaleId, Definition)])
forall a b. Ord a => [(a, b)] -> (Map a b, [(a, b)])
Maps.unique ([(ScaleId, Definition)]
-> (Map ScaleId Definition, [(ScaleId, Definition)]))
-> ([Definition] -> [(ScaleId, Definition)])
-> [Definition]
-> (Map ScaleId Definition, [(ScaleId, Definition)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Definition -> ScaleId) -> [Definition] -> [(ScaleId, Definition)]
forall a k. (a -> k) -> [a] -> [(k, a)]
Seq.key_on Definition -> ScaleId
Scale.scale_id_of