-- | Parser for the SCALA @intnam.par@ file.
module Music.Theory.Tuning.Scala.Interval where

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

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

-- | Interval and name, ie. (3/2,"perfect fifth")
type INTERVAL = (Rational,String)

-- | Length prefixed list of 'INTERVAL'.
type INTNAM = (Int,[INTERVAL])

{- | Lookup ratio in 'INTNAM'.

> db <- load_intnam
> intnam_search_ratio db (3/2) == Just (3/2,"perfect fifth")
> intnam_search_ratio db (2/3) == Nothing
> intnam_search_ratio db (4/3) == Just (4/3,"perfect fourth")
> intnam_search_ratio db (31/16) == Just (31/16,"=31st harmonic")
> intnam_search_ratio db (64/49) == Just (64 % 49,"=2 septatones or septatonic major third")
> map (intnam_search_ratio db) [3/2,4/3,7/4,7/6,9/7,9/8,12/7,14/9]
> import Data.Maybe {- base -}
> mapMaybe (intnam_search_ratio db) [567/512,147/128,21/16,1323/1024,189/128,49/32,441/256,63/32]
-}
intnam_search_ratio :: INTNAM -> Rational -> Maybe INTERVAL
intnam_search_ratio :: INTNAM -> Rational -> Maybe INTERVAL
intnam_search_ratio (Int
_,[INTERVAL]
i) Rational
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== Rational
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [INTERVAL]
i

{- | Lookup approximate ratio in 'INTNAM' given espilon.

> r = [Just (3/2,"perfect fifth"),Just (64/49,"=2 septatones or septatonic major third")]
> map (intnam_search_fratio 0.0001 db) [1.5,1.3061] == r
-}
intnam_search_fratio :: (Fractional n,Ord n) => n -> INTNAM -> n -> Maybe INTERVAL
intnam_search_fratio :: forall n.
(Fractional n, Ord n) =>
n -> INTNAM -> n -> Maybe INTERVAL
intnam_search_fratio n
epsilon (Int
_,[INTERVAL]
i) n
x =
  let near :: n -> n -> Bool
near n
p n
q = forall a. Num a => a -> a
abs (n
p forall a. Num a => a -> a -> a
- n
q) forall a. Ord a => a -> a -> Bool
< n
epsilon
  in forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (n -> n -> Bool
near n
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [INTERVAL]
i

-- | Lookup name of interval, or error.
intnam_search_ratio_name_err :: INTNAM -> Rational -> String
intnam_search_ratio_name_err :: INTNAM -> Rational -> String
intnam_search_ratio_name_err INTNAM
db = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. INTNAM -> Rational -> Maybe INTERVAL
intnam_search_ratio INTNAM
db

-- | Lookup interval name in 'INTNAM', ci = case-insensitive.
--
-- > db <- load_intnam
-- > intnam_search_description_ci db "didymus" == [(81/80,"syntonic comma, Didymus comma")]
intnam_search_description_ci :: INTNAM -> String -> [INTERVAL]
intnam_search_description_ci :: INTNAM -> String -> [INTERVAL]
intnam_search_description_ci (Int
_,[INTERVAL]
i) String
x =
    let downcase :: String -> String
downcase = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
        x' :: String
x' = String -> String
downcase String
x
    in 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
. String -> String
downcase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [INTERVAL]
i

-- * Parser

-- | Parse line from intnam.par
parse_intnam_entry :: String -> INTERVAL
parse_intnam_entry :: String -> INTERVAL
parse_intnam_entry String
str =
    case String -> [String]
words String
str of
      String
r:[String]
w -> (forall i. (Integral i, Read i) => String -> Ratio i
Read.read_ratio_with_div_err String
r,[String] -> String
unwords [String]
w)
      [String]
_ -> forall a. HasCallStack => String -> a
error String
"parse_intnam_entry"

-- | Parse non-comment lines from intnam.par
parse_intnam :: [String] -> INTNAM
parse_intnam :: [String] -> INTNAM
parse_intnam [String]
l =
    case [String]
l of
      String
_:String
n:[String]
i -> let n' :: Int
n' = forall a. Read a => String -> a
read String
n :: Int
                   i' :: [INTERVAL]
i' = forall a b. (a -> b) -> [a] -> [b]
map String -> INTERVAL
parse_intnam_entry [String]
i
               in if Int
n' forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [INTERVAL]
i' then (Int
n',[INTERVAL]
i') else forall a. HasCallStack => String -> a
error String
"parse_intnam"
      [String]
_ -> forall a. HasCallStack => String -> a
error String
"parse_intnam"

-- * IO

{- | 'parse_intnam' of 'Scala.load_dist_file_ln' of "intnam.par".

> intnam <- load_intnam
> fst intnam == 516 -- Scala 2.42p
> fst intnam == length (snd intnam)
> lookup (129140163/128000000) (snd intnam) == Just "gravity comma"
-}
load_intnam :: IO INTNAM
load_intnam :: IO INTNAM
load_intnam = do
  [String]
l <- String -> IO [String]
Scala.load_dist_file_ln String
"intnam.par"
  forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> INTNAM
parse_intnam ([String] -> [String]
Scala.filter_comments [String]
l))