{- | Parser for the @modename.par@ file.

The terminology here is:

- a mode is a subset of the notes of a tuning system (which in scala is called a scale)

- the length (or degree) of the mode is the number of tones in the mode

- the universe (or scale) of the mode is the number of tones in the
  tuning system (or scale) the mode is a subset of

-}
module Music.Theory.Tuning.Scala.Mode where

import Data.Char {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}

import qualified Music.Theory.Function as Function {- hmt -}
import qualified Music.Theory.List as List {- hmt -}
import qualified Music.Theory.Tuning.Scala as Scala {- hmt -}

-- | (mode-start-degree,mode-intervals,mode-description)
type Mode = (Int,[Int],String)

-- | Starting degree of mode in underlying scale.  If non-zero the
-- mode will not lie within an ordinary octave of the tuning.
mode_starting_degree :: Mode -> Int
mode_starting_degree :: Mode -> Int
mode_starting_degree (Int
d,[Int]
_,String
_) = Int
d

-- | Intervals (in steps) between adjacent elements of the mode.
mode_intervals :: Mode -> [Int]
mode_intervals :: Mode -> [Int]
mode_intervals (Int
_,[Int]
i,String
_) = [Int]
i

-- | Interval set of mode (ie. 'nub' of 'sort' of 'mode_intervals')
mode_iset :: Mode -> [Int]
mode_iset :: Mode -> [Int]
mode_iset = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode -> [Int]
mode_intervals

-- | Histogram ('List.histogram') of 'mode_intervals'
mode_histogram :: Mode -> [(Int, Int)]
mode_histogram :: Mode -> [(Int, Int)]
mode_histogram = forall a. Ord a => [a] -> [(a, Int)]
List.histogram forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode -> [Int]
mode_intervals

-- | The text description of the mode, ordinarily a comma separated list of names.
mode_description :: Mode -> String
mode_description :: Mode -> String
mode_description (Int
_,[Int]
_,String
d) = String
d

-- | 'length' (or degree) of 'mode_intervals' (ie. number of notes in mode)
mode_length :: Mode -> Int
mode_length :: Mode -> Int
mode_length = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode -> [Int]
mode_intervals

-- | 'sum' of 'mode_intervals' (ie. number of notes in tuning system)
mode_univ :: Mode -> Int
mode_univ :: Mode -> Int
mode_univ = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode -> [Int]
mode_intervals

-- | 'List.dx_d' of 'mode_intervals'.  This seqence includes the octave.
mode_degree_seq :: Mode -> [Int]
mode_degree_seq :: Mode -> [Int]
mode_degree_seq = forall a. Num a => a -> [a] -> [a]
List.dx_d Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode -> [Int]
mode_intervals

-- | (mode-count,mode-length-maxima,mode-list)
type ModeNam = (Int,Int,[Mode])

modenam_modes :: ModeNam -> [Mode]
modenam_modes :: ModeNam -> [Mode]
modenam_modes (Int
_,Int
_,[Mode]
m) = [Mode]
m

-- | Search for mode by interval list.
modenam_search_seq :: ModeNam -> [Int] -> [Mode]
modenam_search_seq :: ModeNam -> [Int] -> [Mode]
modenam_search_seq (Int
_,Int
_,[Mode]
m) [Int]
x = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== [Int]
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode -> [Int]
mode_intervals) [Mode]
m

-- | Expect /one/ result.
--
-- > mn <- load_modenam
-- > let sq = putStrLn . unlines . mode_stat . fromJust . modenam_search_seq1 mn
-- > sq [2,2,1,2,2,2,1]
-- > sq [2,1,2,2,1,2,2]
-- > sq [2,1,2,2,1,3,1]
-- > sq (replicate 6 2)
-- > sq [1,2,1,2,1,2,1,2]
-- > sq [2,1,2,1,2,1,2,1]
-- > sq (replicate 12 1)
modenam_search_seq1 :: ModeNam -> [Int] -> Maybe Mode
modenam_search_seq1 :: ModeNam -> [Int] -> Maybe Mode
modenam_search_seq1 ModeNam
mn = forall t. [t] -> Maybe t
List.unlist1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModeNam -> [Int] -> [Mode]
modenam_search_seq ModeNam
mn

-- | Search for mode by description text.
--
-- > map (modenam_search_description mn) ["Messiaen","Xenakis","Raga"]
modenam_search_description :: ModeNam -> String -> [Mode]
modenam_search_description :: ModeNam -> String -> [Mode]
modenam_search_description (Int
_,Int
_,[Mode]
m) String
x = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode -> String
mode_description) [Mode]
m

-- | Is /p/ an element of the set of rotations of /q/.
mode_rot_eqv :: Mode -> Mode -> Bool
mode_rot_eqv :: Mode -> Mode -> Bool
mode_rot_eqv Mode
p Mode
q =
  (Mode -> Int
mode_length Mode
p forall a. Eq a => a -> a -> Bool
== Mode -> Int
mode_length Mode
q) Bool -> Bool -> Bool
&&
  (Mode -> Int
mode_univ Mode
p forall a. Eq a => a -> a -> Bool
== Mode -> Int
mode_univ Mode
q) Bool -> Bool -> Bool
&&
  (Mode -> [Int]
mode_intervals Mode
p forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a. [a] -> [[a]]
List.rotations (Mode -> [Int]
mode_intervals Mode
q))

{- | Pretty printer.

> mn <- load_modenam

> let r = filter ((/=) 0 . mode_starting_degree) (modenam_modes mn) -- non-zero starting degrees
> let r = filter ((== [(1,2),(2,5)]) . mode_histogram) (modenam_modes mn) -- 2×1 and 5×2
> let r = filter ((== 22) . mode_univ) (modenam_search_description mn "Raga") -- raga of 22 shruti univ

> [(p,q) | p <- r, q <- r, p < q, mode_rot_eqv p q] -- rotationally equivalent elements of r

> length r
> putStrLn $ unlines $ intercalate ["\n"] $ map mode_stat r
-}
mode_stat :: Mode -> [String]
mode_stat :: Mode -> [String]
mode_stat Mode
m =
  let hst :: [(Int, Int)]
hst = Mode -> [(Int, Int)]
mode_histogram Mode
m
      comma_map :: (a -> String) -> [a] -> String
comma_map a -> String
f = forall a. [a] -> [[a]] -> [a]
intercalate String
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map a -> String
f
  in [String
"mode-start-degree : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Mode -> Int
mode_starting_degree Mode
m)
     ,String
"mode-intervals    : " forall a. [a] -> [a] -> [a]
++ forall {a}. (a -> String) -> [a] -> String
comma_map forall a. Show a => a -> String
show (Mode -> [Int]
mode_intervals Mode
m)
     ,String
"mode-description  : " forall a. [a] -> [a] -> [a]
++ Mode -> String
mode_description Mode
m
     ,String
"mode-length       : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Mode -> Int
mode_length Mode
m)
     ,String
"mode-univ         : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Mode -> Int
mode_univ Mode
m)
     ,String
"mode-interval-set : " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"," (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show (Mode -> [Int]
mode_iset Mode
m))
     ,String
"mode-histogram    : " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"," (forall a b. (a -> b) -> [a] -> [b]
map (\(Int
e,Int
n) -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a. Show a => a -> String
show Int
n,String
"×",forall a. Show a => a -> String
show Int
e]) [(Int, Int)]
hst)
     ,String
"mode-degree-seq   : " forall a. [a] -> [a] -> [a]
++ forall {a}. (a -> String) -> [a] -> String
comma_map forall a. Show a => a -> String
show (Mode -> [Int]
mode_degree_seq Mode
m)
     ]

-- * Parser

-- | Bracketed integers are a non-implicit starting degree.
--
-- > map non_implicit_degree ["4","[4]"] == [Nothing,Just 4]
non_implicit_degree :: String -> Maybe Int
non_implicit_degree :: String -> Maybe Int
non_implicit_degree String
s =
    case forall t. [t] -> Maybe (t, [t], t)
List.unbracket String
s of
      Just (Char
'[',String
x,Char
']') -> forall a. a -> Maybe a
Just (forall a. Read a => String -> a
read String
x)
      Maybe (Char, String, Char)
_ -> forall a. Maybe a
Nothing

-- | Predicate form
is_non_implicit_degree :: String -> Bool
is_non_implicit_degree :: String -> Bool
is_non_implicit_degree = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Int
non_implicit_degree

is_integer :: String -> Bool
is_integer :: String -> Bool
is_integer = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit

parse_modenam_entry :: [String] -> Mode
parse_modenam_entry :: [String] -> Mode
parse_modenam_entry [String]
w =
    let ([String]
n,[String]
c) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall t. (t -> Bool) -> (t -> Bool) -> t -> Bool
Function.predicate_or String -> Bool
is_non_implicit_degree String -> Bool
is_integer) [String]
w
    in case String -> Maybe Int
non_implicit_degree ([String]
n forall a. [a] -> Int -> a
!! Int
0) of
         Maybe Int
Nothing -> (Int
0,forall a b. (a -> b) -> [a] -> [b]
map forall a. Read a => String -> a
read [String]
n,[String] -> String
unwords [String]
c)
         Just Int
d -> (Int
d,forall a b. (a -> b) -> [a] -> [b]
map forall a. Read a => String -> a
read (forall a. [a] -> [a]
tail [String]
n),[String] -> String
unwords [String]
c)

-- | Lines ending with @\@ continue to next line.
join_long_lines :: [String] -> [String]
join_long_lines :: [String] -> [String]
join_long_lines [String]
l =
    case [String]
l of
      String
p:String
q:[String]
l' -> case forall a. [a] -> ([a], Maybe a)
List.separate_last' String
p of
                  (String
p',Just Char
'\\') -> [String] -> [String]
join_long_lines ((String
p' forall a. [a] -> [a] -> [a]
++ String
q) forall a. a -> [a] -> [a]
: [String]
l')
                  (String, Maybe Char)
_ -> String
p forall a. a -> [a] -> [a]
: [String] -> [String]
join_long_lines (String
q forall a. a -> [a] -> [a]
: [String]
l')
      [String]
_ -> [String]
l

-- | Parse joined non-comment lines of modenam file.
parse_modenam :: [String] -> ModeNam
parse_modenam :: [String] -> ModeNam
parse_modenam [String]
l =
    case [String]
l of
      String
n_str:String
x_str:[String]
m_str ->
        let n :: Int
n = forall a. Read a => String -> a
read String
n_str :: Int
            x :: Int
x = forall a. Read a => String -> a
read String
x_str :: Int
            m :: [Mode]
m = forall a b. (a -> b) -> [a] -> [b]
map ([String] -> Mode
parse_modenam_entry forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) [String]
m_str
        in if Int
n forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mode]
m then (Int
n,Int
x,[Mode]
m) else forall a. HasCallStack => String -> a
error String
"parse_modenam"
      [String]
_ -> forall a. HasCallStack => String -> a
error String
"parse_modenam"

-- * Io

{- | 'parse_modenam' of 'Scala.load_dist_file' of @modenam.par@.

> mn <- load_modenam
> let (n,x,m) = mn
> (n, x, length m) == (3087,15,3087) -- Scala 2.64p
-}
load_modenam :: IO ModeNam
load_modenam :: IO ModeNam
load_modenam = do
  [String]
l <- String -> IO [String]
Scala.load_dist_file_ln String
"modenam.par"
  forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> ModeNam
parse_modenam ([String] -> [String]
Scala.filter_comments ([String] -> [String]
join_long_lines [String]
l)))