-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{- | Hardcoded scale map.

    This is to scales as Derive.Call.All is to calls.
-}
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

-- | (scale_id, pattern, doc)
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)

-- | This is the hardcoded scale map.  It is merged with the static config
-- scale map at startup.
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