module Sound.Tidal.Scales (scale, scaleList, scaleTable, getScale, scaleWith, scaleWithList, raiseDegree, lowerDegree, raiseDegrees, lowerDegrees) where

{-
    Scale.hs - Scales for TidalCycles
    Copyright (C) 2020, lvm (Mauro) and contributors

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

import Data.Maybe (fromMaybe)
import Sound.Tidal.Core (slowcat)
import Sound.Tidal.Pattern (Pattern, (<*))
import Sound.Tidal.Utils ((!!!))
import Prelude hiding ((*>), (<*))

-- * Scale definitions

-- ** Five notes scales

minPent :: (Fractional a) => [a]
minPent :: forall a. Fractional a => [a]
minPent = [a
0, a
3, a
5, a
7, a
10]

majPent :: (Fractional a) => [a]
majPent :: forall a. Fractional a => [a]
majPent = [a
0, a
2, a
4, a
7, a
9]

-- | Another mode of major pentatonic
ritusen :: (Fractional a) => [a]
ritusen :: forall a. Fractional a => [a]
ritusen = [a
0, a
2, a
5, a
7, a
9]

-- | Another mode of major pentatonic
egyptian :: (Fractional a) => [a]
egyptian :: forall a. Fractional a => [a]
egyptian = [a
0, a
2, a
5, a
7, a
10]

-- *** Other scales

kumai :: (Fractional a) => [a]
kumai :: forall a. Fractional a => [a]
kumai = [a
0, a
2, a
3, a
7, a
9]

hirajoshi :: (Fractional a) => [a]
hirajoshi :: forall a. Fractional a => [a]
hirajoshi = [a
0, a
2, a
3, a
7, a
8]

iwato :: (Fractional a) => [a]
iwato :: forall a. Fractional a => [a]
iwato = [a
0, a
1, a
5, a
6, a
10]

chinese :: (Fractional a) => [a]
chinese :: forall a. Fractional a => [a]
chinese = [a
0, a
4, a
6, a
7, a
11]

indian :: (Fractional a) => [a]
indian :: forall a. Fractional a => [a]
indian = [a
0, a
4, a
5, a
7, a
10]

pelog :: (Fractional a) => [a]
pelog :: forall a. Fractional a => [a]
pelog = [a
0, a
1, a
3, a
7, a
8]

-- *** More scales

prometheus :: (Fractional a) => [a]
prometheus :: forall a. Fractional a => [a]
prometheus = [a
0, a
2, a
4, a
6, a
11]

scriabin :: (Fractional a) => [a]
scriabin :: forall a. Fractional a => [a]
scriabin = [a
0, a
1, a
4, a
7, a
9]

-- *** Han Chinese pentatonic scales

gong :: (Fractional a) => [a]
gong :: forall a. Fractional a => [a]
gong = [a
0, a
2, a
4, a
7, a
9]

shang :: (Fractional a) => [a]
shang :: forall a. Fractional a => [a]
shang = [a
0, a
2, a
5, a
7, a
10]

jiao :: (Fractional a) => [a]
jiao :: forall a. Fractional a => [a]
jiao = [a
0, a
3, a
5, a
8, a
10]

zhi :: (Fractional a) => [a]
zhi :: forall a. Fractional a => [a]
zhi = [a
0, a
2, a
5, a
7, a
9]

yu :: (Fractional a) => [a]
yu :: forall a. Fractional a => [a]
yu = [a
0, a
3, a
5, a
7, a
10]

-- ** 6 note scales

whole' :: (Fractional a) => [a]
whole' :: forall a. Fractional a => [a]
whole' = [a
0, a
2, a
4, a
6, a
8, a
10]

augmented :: (Fractional a) => [a]
augmented :: forall a. Fractional a => [a]
augmented = [a
0, a
3, a
4, a
7, a
8, a
11]

augmented2 :: (Fractional a) => [a]
augmented2 :: forall a. Fractional a => [a]
augmented2 = [a
0, a
1, a
4, a
5, a
8, a
9]

-- *** Hexatonic modes with no tritone

hexMajor7 :: (Fractional a) => [a]
hexMajor7 :: forall a. Fractional a => [a]
hexMajor7 = [a
0, a
2, a
4, a
7, a
9, a
11]

hexDorian :: (Fractional a) => [a]
hexDorian :: forall a. Fractional a => [a]
hexDorian = [a
0, a
2, a
3, a
5, a
7, a
10]

hexPhrygian :: (Fractional a) => [a]
hexPhrygian :: forall a. Fractional a => [a]
hexPhrygian = [a
0, a
1, a
3, a
5, a
8, a
10]

hexSus :: (Fractional a) => [a]
hexSus :: forall a. Fractional a => [a]
hexSus = [a
0, a
2, a
5, a
7, a
9, a
10]

hexMajor6 :: (Fractional a) => [a]
hexMajor6 :: forall a. Fractional a => [a]
hexMajor6 = [a
0, a
2, a
4, a
5, a
7, a
9]

hexAeolian :: (Fractional a) => [a]
hexAeolian :: forall a. Fractional a => [a]
hexAeolian = [a
0, a
3, a
5, a
7, a
8, a
10]

-- ** 7 note scales

major :: (Fractional a) => [a]
major :: forall a. Fractional a => [a]
major = [a
0, a
2, a
4, a
5, a
7, a
9, a
11]

ionian :: (Fractional a) => [a]
ionian :: forall a. Fractional a => [a]
ionian = [a
0, a
2, a
4, a
5, a
7, a
9, a
11]

dorian :: (Fractional a) => [a]
dorian :: forall a. Fractional a => [a]
dorian = [a
0, a
2, a
3, a
5, a
7, a
9, a
10]

phrygian :: (Fractional a) => [a]
phrygian :: forall a. Fractional a => [a]
phrygian = [a
0, a
1, a
3, a
5, a
7, a
8, a
10]

lydian :: (Fractional a) => [a]
lydian :: forall a. Fractional a => [a]
lydian = [a
0, a
2, a
4, a
6, a
7, a
9, a
11]

mixolydian :: (Fractional a) => [a]
mixolydian :: forall a. Fractional a => [a]
mixolydian = [a
0, a
2, a
4, a
5, a
7, a
9, a
10]

aeolian :: (Fractional a) => [a]
aeolian :: forall a. Fractional a => [a]
aeolian = [a
0, a
2, a
3, a
5, a
7, a
8, a
10]

minor :: (Fractional a) => [a]
minor :: forall a. Fractional a => [a]
minor = [a
0, a
2, a
3, a
5, a
7, a
8, a
10]

locrian :: (Fractional a) => [a]
locrian :: forall a. Fractional a => [a]
locrian = [a
0, a
1, a
3, a
5, a
6, a
8, a
10]

harmonicMinor :: (Fractional a) => [a]
harmonicMinor :: forall a. Fractional a => [a]
harmonicMinor = [a
0, a
2, a
3, a
5, a
7, a
8, a
11]

harmonicMajor :: (Fractional a) => [a]
harmonicMajor :: forall a. Fractional a => [a]
harmonicMajor = [a
0, a
2, a
4, a
5, a
7, a
8, a
11]

melodicMinor :: (Fractional a) => [a]
melodicMinor :: forall a. Fractional a => [a]
melodicMinor = [a
0, a
2, a
3, a
5, a
7, a
9, a
11]

melodicMinorDesc :: (Fractional a) => [a]
melodicMinorDesc :: forall a. Fractional a => [a]
melodicMinorDesc = [a
0, a
2, a
3, a
5, a
7, a
8, a
10]

melodicMajor :: (Fractional a) => [a]
melodicMajor :: forall a. Fractional a => [a]
melodicMajor = [a
0, a
2, a
4, a
5, a
7, a
8, a
10]

bartok :: (Fractional a) => [a]
bartok :: forall a. Fractional a => [a]
bartok = [a]
forall a. Fractional a => [a]
melodicMajor

hindu :: (Fractional a) => [a]
hindu :: forall a. Fractional a => [a]
hindu = [a]
forall a. Fractional a => [a]
melodicMajor

-- *** Raga modes

todi :: (Fractional a) => [a]
todi :: forall a. Fractional a => [a]
todi = [a
0, a
1, a
3, a
6, a
7, a
8, a
11]

purvi :: (Fractional a) => [a]
purvi :: forall a. Fractional a => [a]
purvi = [a
0, a
1, a
4, a
6, a
7, a
8, a
11]

marva :: (Fractional a) => [a]
marva :: forall a. Fractional a => [a]
marva = [a
0, a
1, a
4, a
6, a
7, a
9, a
11]

bhairav :: (Fractional a) => [a]
bhairav :: forall a. Fractional a => [a]
bhairav = [a
0, a
1, a
4, a
5, a
7, a
8, a
11]

ahirbhairav :: (Fractional a) => [a]
ahirbhairav :: forall a. Fractional a => [a]
ahirbhairav = [a
0, a
1, a
4, a
5, a
7, a
9, a
10]

-- *** More modes

superLocrian :: (Fractional a) => [a]
superLocrian :: forall a. Fractional a => [a]
superLocrian = [a
0, a
1, a
3, a
4, a
6, a
8, a
10]

romanianMinor :: (Fractional a) => [a]
romanianMinor :: forall a. Fractional a => [a]
romanianMinor = [a
0, a
2, a
3, a
6, a
7, a
9, a
10]

hungarianMinor :: (Fractional a) => [a]
hungarianMinor :: forall a. Fractional a => [a]
hungarianMinor = [a
0, a
2, a
3, a
6, a
7, a
8, a
11]

neapolitanMinor :: (Fractional a) => [a]
neapolitanMinor :: forall a. Fractional a => [a]
neapolitanMinor = [a
0, a
1, a
3, a
5, a
7, a
8, a
11]

enigmatic :: (Fractional a) => [a]
enigmatic :: forall a. Fractional a => [a]
enigmatic = [a
0, a
1, a
4, a
6, a
8, a
10, a
11]

spanish :: (Fractional a) => [a]
spanish :: forall a. Fractional a => [a]
spanish = [a
0, a
1, a
4, a
5, a
7, a
8, a
10]

-- *** Modes of whole tones with added note ->

leadingWhole :: (Fractional a) => [a]
leadingWhole :: forall a. Fractional a => [a]
leadingWhole = [a
0, a
2, a
4, a
6, a
8, a
10, a
11]

lydianMinor :: (Fractional a) => [a]
lydianMinor :: forall a. Fractional a => [a]
lydianMinor = [a
0, a
2, a
4, a
6, a
7, a
8, a
10]

neapolitanMajor :: (Fractional a) => [a]
neapolitanMajor :: forall a. Fractional a => [a]
neapolitanMajor = [a
0, a
1, a
3, a
5, a
7, a
9, a
11]

locrianMajor :: (Fractional a) => [a]
locrianMajor :: forall a. Fractional a => [a]
locrianMajor = [a
0, a
2, a
4, a
5, a
6, a
8, a
10]

-- ** 8 note scales

diminished :: (Fractional a) => [a]
diminished :: forall a. Fractional a => [a]
diminished = [a
0, a
1, a
3, a
4, a
6, a
7, a
9, a
10]

diminished2 :: (Fractional a) => [a]
diminished2 :: forall a. Fractional a => [a]
diminished2 = [a
0, a
2, a
3, a
5, a
6, a
8, a
9, a
11]

-- ** Modes of limited transposition

messiaen1 :: (Fractional a) => [a]
messiaen1 :: forall a. Fractional a => [a]
messiaen1 = [a]
forall a. Fractional a => [a]
whole'

messiaen2 :: (Fractional a) => [a]
messiaen2 :: forall a. Fractional a => [a]
messiaen2 = [a]
forall a. Fractional a => [a]
diminished

messiaen3 :: (Fractional a) => [a]
messiaen3 :: forall a. Fractional a => [a]
messiaen3 = [a
0, a
2, a
3, a
4, a
6, a
7, a
8, a
10, a
11]

messiaen4 :: (Fractional a) => [a]
messiaen4 :: forall a. Fractional a => [a]
messiaen4 = [a
0, a
1, a
2, a
5, a
6, a
7, a
8, a
11]

messiaen5 :: (Fractional a) => [a]
messiaen5 :: forall a. Fractional a => [a]
messiaen5 = [a
0, a
1, a
5, a
6, a
7, a
11]

messiaen6 :: (Fractional a) => [a]
messiaen6 :: forall a. Fractional a => [a]
messiaen6 = [a
0, a
2, a
4, a
5, a
6, a
8, a
10, a
11]

messiaen7 :: (Fractional a) => [a]
messiaen7 :: forall a. Fractional a => [a]
messiaen7 = [a
0, a
1, a
2, a
3, a
5, a
6, a
7, a
8, a
9, a
11]

-- ** Arabic maqams taken from SuperCollider's Scale.sc

bayati :: (Fractional a) => [a]
bayati :: forall a. Fractional a => [a]
bayati = [a
0, a
1.5, a
3, a
5, a
7, a
8, a
10]

hijaz :: (Fractional a) => [a]
hijaz :: forall a. Fractional a => [a]
hijaz = [a
0, a
1, a
4, a
5, a
7, a
8.5, a
10]

sikah :: (Fractional a) => [a]
sikah :: forall a. Fractional a => [a]
sikah = [a
0, a
1.5, a
3.5, a
5.5, a
7, a
8.5, a
10.5]

rast :: (Fractional a) => [a]
rast :: forall a. Fractional a => [a]
rast = [a
0, a
2, a
3.5, a
5, a
7, a
9, a
10.5]

iraq :: (Fractional a) => [a]
iraq :: forall a. Fractional a => [a]
iraq = [a
0, a
1.5, a
3.5, a
5, a
6.5, a
8.5, a
10.5]

saba :: (Fractional a) => [a]
saba :: forall a. Fractional a => [a]
saba = [a
0, a
1.5, a
3, a
4, a
6, a
8, a
10]

-- ** 12 note scales

chromatic :: (Fractional a) => [a]
chromatic :: forall a. Fractional a => [a]
chromatic = [a
0, a
1, a
2, a
3, a
4, a
5, a
6, a
7, a
8, a
9, a
10, a
11]

-- |
--  Interprets a pattern of note numbers into a particular named scale. For example:
--
--  > d1
--  >   $ jux rev
--  >   $ chunk 4 (fast 2 . (|- n 12))
--  >   $ off 0.25 (|+ 7)
--  >   $ struct (iter 4 "t(5,8)")
--  >   $ n (scale "ritusen" "0 .. 7")
--  >   # sound "superpiano"
scale :: (Fractional a) => Pattern String -> Pattern Int -> Pattern a
scale :: forall a.
Fractional a =>
Pattern String -> Pattern Int -> Pattern a
scale = [(String, [a])] -> Pattern String -> Pattern Int -> Pattern a
forall a.
Fractional a =>
[(String, [a])] -> Pattern String -> Pattern Int -> Pattern a
getScale [(String, [a])]
forall a. Fractional a => [(String, [a])]
scaleTable

-- |
--  Build a scale function, with additional scales if you wish. For example:
--
--  > let myscale =
--  >   getScale
--  >     ( scaleTable ++
--  >         [ ("techno", [0,2,3,5,7,8,10])
--  >         , ("broken", [0,1,4,7,8,10])
--  >         ]
--  >     )
--
--  The above takes the standard 'scaleTable' as a starting point and adds two custom scales to it. You’ll be able to use the new function in place of the normal one:
--
--  > d1 $ n (myscale "techno" "0 1 2 3 4 5 6 7") # sound "superpiano"
getScale :: (Fractional a) => [(String, [a])] -> Pattern String -> Pattern Int -> Pattern a
getScale :: forall a.
Fractional a =>
[(String, [a])] -> Pattern String -> Pattern Int -> Pattern a
getScale [(String, [a])]
table Pattern String
sp Pattern Int
p =
  ( \Int
n String
scaleName ->
      [a] -> Int -> a
forall {a}. Num a => [a] -> Int -> a
noteInScale ([a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [a
0] (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ String -> [(String, [a])] -> Maybe [a]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
scaleName [(String, [a])]
table) Int
n
  )
    (Int -> String -> a) -> Pattern Int -> Pattern (String -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
p
    Pattern (String -> a) -> Pattern String -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern String
sp
  where
    octave :: t a -> Int -> Int
octave t a
s Int
x = Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
s
    noteInScale :: [a] -> Int -> a
noteInScale [a]
s Int
x = ([a]
s [a] -> Int -> a
forall a. [a] -> Int -> a
!!! Int
x) a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [a] -> Int -> Int
forall {t :: * -> *} {a}. Foldable t => t a -> Int -> Int
octave [a]
s Int
x)

{- Variant of @scale@ allowing to modify the current scale (seen as a list) with an [a] -> [a] function.

These are equivalent:

> d1 $ up (scaleWith "major" (insert 1) $ run 8) # s "superpiano"
> d1 $ up "0 1 2 4 5 7 9 11" # s "superpiano"

-}
scaleWith :: (Eq a, Fractional a) => Pattern String -> ([a] -> [a]) -> Pattern Int -> Pattern a
scaleWith :: forall a.
(Eq a, Fractional a) =>
Pattern String -> ([a] -> [a]) -> Pattern Int -> Pattern a
scaleWith = [(String, [a])]
-> Pattern String -> ([a] -> [a]) -> Pattern Int -> Pattern a
forall a.
(Eq a, Fractional a) =>
[(String, [a])]
-> Pattern String -> ([a] -> [a]) -> Pattern Int -> Pattern a
getScaleMod [(String, [a])]
forall a. Fractional a => [(String, [a])]
scaleTable

{- Variant of @scaleWith@ providing a list of modifier functions instead of a single function
-}
scaleWithList :: (Eq a, Fractional a) => Pattern String -> ([[a] -> [a]]) -> Pattern Int -> Pattern a
scaleWithList :: forall a.
(Eq a, Fractional a) =>
Pattern String -> [[a] -> [a]] -> Pattern Int -> Pattern a
scaleWithList Pattern String
sp [[a] -> [a]]
fs Pattern Int
p = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
slowcat ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ (([a] -> [a]) -> Pattern a) -> [[a] -> [a]] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map (\[a] -> [a]
f -> Pattern String -> ([a] -> [a]) -> Pattern Int -> Pattern a
forall a.
(Eq a, Fractional a) =>
Pattern String -> ([a] -> [a]) -> Pattern Int -> Pattern a
scaleWith Pattern String
sp [a] -> [a]
f Pattern Int
p) [[a] -> [a]]
fs

{- Variant of @getScale@ used to build the @scaleWith@ function
-}
getScaleMod :: (Eq a, Fractional a) => [(String, [a])] -> Pattern String -> ([a] -> [a]) -> Pattern Int -> Pattern a
getScaleMod :: forall a.
(Eq a, Fractional a) =>
[(String, [a])]
-> Pattern String -> ([a] -> [a]) -> Pattern Int -> Pattern a
getScaleMod [(String, [a])]
table Pattern String
sp [a] -> [a]
f Pattern Int
p =
  ( \Int
n String
scaleName ->
      [a] -> Int -> a
forall {a}. Num a => [a] -> Int -> a
noteInScale ([a] -> [a]
forall a. Eq a => [a] -> [a]
uniq ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
f ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [a
0] (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ String -> [(String, [a])] -> Maybe [a]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
scaleName [(String, [a])]
table) Int
n
  )
    (Int -> String -> a) -> Pattern Int -> Pattern (String -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
p
    Pattern (String -> a) -> Pattern String -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern String
sp
  where
    octave :: t a -> Int -> Int
octave t a
s Int
x = Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
s
    noteInScale :: [a] -> Int -> a
noteInScale [a]
s Int
x = ([a]
s [a] -> Int -> a
forall a. [a] -> Int -> a
!!! Int
x) a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [a] -> Int -> Int
forall {t :: * -> *} {a}. Foldable t => t a -> Int -> Int
octave [a]
s Int
x)

{- Eliminates duplicates in a sorted list
-}
uniq :: (Eq a) => [a] -> [a]
uniq :: forall a. Eq a => [a] -> [a]
uniq (a
h1 : a
h2 : [a]
tl) = if (a
h1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
h2) then a
h1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ([a] -> [a]
forall a. Eq a => [a] -> [a]
uniq [a]
tl) else a
h1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ([a] -> [a]
forall a. Eq a => [a] -> [a]
uniq (a
h2 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
tl))
uniq [a]
l = [a]
l

{- Raises a specified degree of a scale, provided as a numbers list.
Meant to be passed as an argument to @scaleWith@
-}
raiseDegree :: (Fractional a) => Int -> [a] -> [a]
raiseDegree :: forall a. Fractional a => Int -> [a] -> [a]
raiseDegree Int
_ (a
hd : []) = (a
hd a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: []
raiseDegree Int
0 (a
hd : [a]
tl) = (a
hd a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
tl
raiseDegree Int
n (a
hd : [a]
tl) = a
hd a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Int -> [a] -> [a]
forall a. Fractional a => Int -> [a] -> [a]
raiseDegree (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
tl)
raiseDegree Int
_ [] = String -> [a]
forall a. HasCallStack => String -> a
error String
"Degree is not present in the scale"

{- Lowers a specified degree of a scale, provided as a numbers list.
Meant to be passed as an argument to @scaleWith@
-}
lowerDegree :: (Fractional a) => Int -> [a] -> [a]
lowerDegree :: forall a. Fractional a => Int -> [a] -> [a]
lowerDegree Int
_ (a
hd : []) = (a
hd a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: []
lowerDegree Int
0 (a
hd : [a]
tl) = (a
hd a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
tl
lowerDegree Int
n (a
hd : [a]
tl) = a
hd a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Int -> [a] -> [a]
forall a. Fractional a => Int -> [a] -> [a]
lowerDegree (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
tl)
lowerDegree Int
_ [] = String -> [a]
forall a. HasCallStack => String -> a
error String
"Degree is not present in the scale"

{- Like @raiseDegree@, but raises a range of degrees instead of a single one
-}
raiseDegrees :: (Fractional a) => Int -> Int -> [a] -> [a]
raiseDegrees :: forall a. Fractional a => Int -> Int -> [a] -> [a]
raiseDegrees Int
_ Int
_ (a
hd : []) = (a
hd a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: []
raiseDegrees Int
0 Int
0 (a
hd : [a]
tl) = (a
hd a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
tl
raiseDegrees Int
0 Int
m (a
hd : [a]
tl) = (a
hd a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Int -> Int -> [a] -> [a]
forall a. Fractional a => Int -> Int -> [a] -> [a]
raiseDegrees Int
0 (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
tl)
raiseDegrees Int
n Int
m (a
hd : [a]
tl) = a
hd a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Int -> Int -> [a] -> [a]
forall a. Fractional a => Int -> Int -> [a] -> [a]
raiseDegrees (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
tl)
raiseDegrees Int
_ Int
_ [] = String -> [a]
forall a. HasCallStack => String -> a
error String
"Degrees are out of the scale"

{- Like @lowerDegree@, but lowers a range of degrees instead of a single one
-}
lowerDegrees :: (Fractional a) => Int -> Int -> [a] -> [a]
lowerDegrees :: forall a. Fractional a => Int -> Int -> [a] -> [a]
lowerDegrees Int
_ Int
_ (a
hd : []) = (a
hd a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: []
lowerDegrees Int
0 Int
0 (a
hd : [a]
tl) = (a
hd a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
tl
lowerDegrees Int
0 Int
m (a
hd : [a]
tl) = (a
hd a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Int -> Int -> [a] -> [a]
forall a. Fractional a => Int -> Int -> [a] -> [a]
lowerDegrees Int
0 (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
tl)
lowerDegrees Int
n Int
m (a
hd : [a]
tl) = a
hd a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Int -> Int -> [a] -> [a]
forall a. Fractional a => Int -> Int -> [a] -> [a]
lowerDegrees (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
tl)
lowerDegrees Int
_ Int
_ [] = String -> [a]
forall a. HasCallStack => String -> a
error String
"Degrees are out of the scale"

-- |
--  Outputs this list of all the available scales:
--
-- @
-- minPent majPent ritusen egyptian kumai hirajoshi iwato chinese indian pelog
-- prometheus scriabin gong shang jiao zhi yu whole wholetone augmented augmented2
-- hexMajor7 hexDorian hexPhrygian hexSus hexMajor6 hexAeolian major ionian dorian
-- phrygian lydian mixolydian aeolian minor locrian harmonicMinor harmonicMajor
-- melodicMinor melodicMinorDesc melodicMajor bartok hindu todi purvi marva bhairav
-- ahirbhairav superLocrian romanianMinor hungarianMinor neapolitanMinor enigmatic
-- spanish leadingWhole lydianMinor neapolitanMajor locrianMajor diminished
-- octatonic diminished2 octatonic2 messiaen1 messiaen2 messiaen3 messiaen4
-- messiaen5 messiaen6 messiaen7 chromatic bayati hijaz sikah rast saba iraq
-- @
scaleList :: String
scaleList :: String
scaleList = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((String, [Rational]) -> String)
-> [(String, [Rational])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [Rational]) -> String
forall a b. (a, b) -> a
fst ([(String, [Rational])]
forall a. Fractional a => [(String, [a])]
scaleTable :: [(String, [Rational])])

-- |
--  Outputs a list of all available scales and their corresponding notes. For
--  example, its first entry is @("minPent",[0,3,5,7,10]@) which means that
--  a minor pentatonic scale is formed by the root (0), the minor third (3 semitones
--  above the root), the perfect fourth (5 semitones above the root), etc.
--
--  As the list is big, you can use the Haskell function lookup to look up a
--  specific scale: @lookup "phrygian" scaleTable@. This will output
--  @Just [0.0,1.0,3.0,5.0,7.0,8.0,10.0]@.
--
--  You can also do a reverse lookup into the scale table. For example:
--
--  > filter ( \(_, x) -> take 3 x == [0,2,4] ) scaleTable
--
--  The above example will output all scales of which the first three notes are
--  the root, the major second (2 semitones above the fundamental), and the major
--  third (4 semitones above the root).
scaleTable :: (Fractional a) => [(String, [a])]
scaleTable :: forall a. Fractional a => [(String, [a])]
scaleTable =
  [ (String
"minPent", [a]
forall a. Fractional a => [a]
minPent),
    (String
"majPent", [a]
forall a. Fractional a => [a]
majPent),
    (String
"ritusen", [a]
forall a. Fractional a => [a]
ritusen),
    (String
"egyptian", [a]
forall a. Fractional a => [a]
egyptian),
    (String
"kumai", [a]
forall a. Fractional a => [a]
kumai),
    (String
"hirajoshi", [a]
forall a. Fractional a => [a]
hirajoshi),
    (String
"iwato", [a]
forall a. Fractional a => [a]
iwato),
    (String
"chinese", [a]
forall a. Fractional a => [a]
chinese),
    (String
"indian", [a]
forall a. Fractional a => [a]
indian),
    (String
"pelog", [a]
forall a. Fractional a => [a]
pelog),
    (String
"prometheus", [a]
forall a. Fractional a => [a]
prometheus),
    (String
"scriabin", [a]
forall a. Fractional a => [a]
scriabin),
    (String
"gong", [a]
forall a. Fractional a => [a]
gong),
    (String
"shang", [a]
forall a. Fractional a => [a]
shang),
    (String
"jiao", [a]
forall a. Fractional a => [a]
jiao),
    (String
"zhi", [a]
forall a. Fractional a => [a]
zhi),
    (String
"yu", [a]
forall a. Fractional a => [a]
yu),
    (String
"whole", [a]
forall a. Fractional a => [a]
whole'),
    (String
"wholetone", [a]
forall a. Fractional a => [a]
whole'),
    (String
"augmented", [a]
forall a. Fractional a => [a]
augmented),
    (String
"augmented2", [a]
forall a. Fractional a => [a]
augmented2),
    (String
"hexMajor7", [a]
forall a. Fractional a => [a]
hexMajor7),
    (String
"hexDorian", [a]
forall a. Fractional a => [a]
hexDorian),
    (String
"hexPhrygian", [a]
forall a. Fractional a => [a]
hexPhrygian),
    (String
"hexSus", [a]
forall a. Fractional a => [a]
hexSus),
    (String
"hexMajor6", [a]
forall a. Fractional a => [a]
hexMajor6),
    (String
"hexAeolian", [a]
forall a. Fractional a => [a]
hexAeolian),
    (String
"major", [a]
forall a. Fractional a => [a]
major),
    (String
"ionian", [a]
forall a. Fractional a => [a]
ionian),
    (String
"dorian", [a]
forall a. Fractional a => [a]
dorian),
    (String
"phrygian", [a]
forall a. Fractional a => [a]
phrygian),
    (String
"lydian", [a]
forall a. Fractional a => [a]
lydian),
    (String
"mixolydian", [a]
forall a. Fractional a => [a]
mixolydian),
    (String
"aeolian", [a]
forall a. Fractional a => [a]
aeolian),
    (String
"minor", [a]
forall a. Fractional a => [a]
minor),
    (String
"locrian", [a]
forall a. Fractional a => [a]
locrian),
    (String
"harmonicMinor", [a]
forall a. Fractional a => [a]
harmonicMinor),
    (String
"harmonicMajor", [a]
forall a. Fractional a => [a]
harmonicMajor),
    (String
"melodicMinor", [a]
forall a. Fractional a => [a]
melodicMinor),
    (String
"melodicMinorDesc", [a]
forall a. Fractional a => [a]
melodicMinorDesc),
    (String
"melodicMajor", [a]
forall a. Fractional a => [a]
melodicMajor),
    (String
"bartok", [a]
forall a. Fractional a => [a]
bartok),
    (String
"hindu", [a]
forall a. Fractional a => [a]
hindu),
    (String
"todi", [a]
forall a. Fractional a => [a]
todi),
    (String
"purvi", [a]
forall a. Fractional a => [a]
purvi),
    (String
"marva", [a]
forall a. Fractional a => [a]
marva),
    (String
"bhairav", [a]
forall a. Fractional a => [a]
bhairav),
    (String
"ahirbhairav", [a]
forall a. Fractional a => [a]
ahirbhairav),
    (String
"superLocrian", [a]
forall a. Fractional a => [a]
superLocrian),
    (String
"romanianMinor", [a]
forall a. Fractional a => [a]
romanianMinor),
    (String
"hungarianMinor", [a]
forall a. Fractional a => [a]
hungarianMinor),
    (String
"neapolitanMinor", [a]
forall a. Fractional a => [a]
neapolitanMinor),
    (String
"enigmatic", [a]
forall a. Fractional a => [a]
enigmatic),
    (String
"spanish", [a]
forall a. Fractional a => [a]
spanish),
    (String
"leadingWhole", [a]
forall a. Fractional a => [a]
leadingWhole),
    (String
"lydianMinor", [a]
forall a. Fractional a => [a]
lydianMinor),
    (String
"neapolitanMajor", [a]
forall a. Fractional a => [a]
neapolitanMajor),
    (String
"locrianMajor", [a]
forall a. Fractional a => [a]
locrianMajor),
    (String
"diminished", [a]
forall a. Fractional a => [a]
diminished),
    (String
"octatonic", [a]
forall a. Fractional a => [a]
diminished),
    (String
"diminished2", [a]
forall a. Fractional a => [a]
diminished2),
    (String
"octatonic2", [a]
forall a. Fractional a => [a]
diminished2),
    (String
"messiaen1", [a]
forall a. Fractional a => [a]
messiaen1),
    (String
"messiaen2", [a]
forall a. Fractional a => [a]
messiaen2),
    (String
"messiaen3", [a]
forall a. Fractional a => [a]
messiaen3),
    (String
"messiaen4", [a]
forall a. Fractional a => [a]
messiaen4),
    (String
"messiaen5", [a]
forall a. Fractional a => [a]
messiaen5),
    (String
"messiaen6", [a]
forall a. Fractional a => [a]
messiaen6),
    (String
"messiaen7", [a]
forall a. Fractional a => [a]
messiaen7),
    (String
"chromatic", [a]
forall a. Fractional a => [a]
chromatic),
    (String
"bayati", [a]
forall a. Fractional a => [a]
bayati),
    (String
"hijaz", [a]
forall a. Fractional a => [a]
hijaz),
    (String
"sikah", [a]
forall a. Fractional a => [a]
sikah),
    (String
"rast", [a]
forall a. Fractional a => [a]
rast),
    (String
"saba", [a]
forall a. Fractional a => [a]
saba),
    (String
"iraq", [a]
forall a. Fractional a => [a]
iraq)
  ]