module Sound.MIDI.KeySignature (
   T(..),
   Accidentals(..), Mode(..), keyName,

   cfMajor, gfMajor, dfMajor, afMajor, efMajor,
   bfMajor, fMajor, cMajor, gMajor, dMajor, aMajor,
   eMajor, bMajor, fsMajor, csMajor,
   afMinor, efMinor, bfMinor, fMinor, cMinor,
   gMinor, dMinor, aMinor, eMinor, bMinor, fsMinor,
   csMinor, gsMinor, dsMinor, asMinor,

   get, toBytes, ) where

import Sound.MIDI.Parser.Primitive (getByte, getEnum, makeEnum, )
import qualified Sound.MIDI.Parser.Class as Parser

import Control.Monad (liftM2, )

import Data.Ix (Ix, inRange, )
import Sound.MIDI.Utility
         (enumRandomR, boundedEnumRandom, chooseEnum, checkRange, )

import Test.QuickCheck (Arbitrary(arbitrary), )
import System.Random (Random(random, randomR), )

import Data.Int (Int8, )

import Prelude hiding (putStr, )



data T = Cons Mode Accidentals
   deriving (T -> T -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: T -> T -> Bool
$c/= :: T -> T -> Bool
== :: T -> T -> Bool
$c== :: T -> T -> Bool
Eq, Eq T
T -> T -> Bool
T -> T -> Ordering
T -> T -> T
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: T -> T -> T
$cmin :: T -> T -> T
max :: T -> T -> T
$cmax :: T -> T -> T
>= :: T -> T -> Bool
$c>= :: T -> T -> Bool
> :: T -> T -> Bool
$c> :: T -> T -> Bool
<= :: T -> T -> Bool
$c<= :: T -> T -> Bool
< :: T -> T -> Bool
$c< :: T -> T -> Bool
compare :: T -> T -> Ordering
$ccompare :: T -> T -> Ordering
Ord)

instance Show T where
   showsPrec :: Int -> T -> ShowS
showsPrec Int
p (Cons Mode
mode Accidentals
accs) =
      if forall a. Ix a => (a, a) -> a -> Bool
inRange (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound) Accidentals
accs
        then String -> ShowS
showString String
"KeySig." forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             String -> ShowS
showString (Mode -> Accidentals -> String
keyName Mode
mode Accidentals
accs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Mode
mode
        else Bool -> ShowS -> ShowS
showParen (Int
pforall a. Ord a => a -> a -> Bool
>Int
10) forall a b. (a -> b) -> a -> b
$
             String -> ShowS
showString String
"KeySig.Cons " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Mode
mode forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Accidentals
accs

instance Arbitrary T where
   arbitrary :: Gen T
arbitrary = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Mode -> Accidentals -> T
Cons forall a. Arbitrary a => Gen a
arbitrary forall a. Arbitrary a => Gen a
arbitrary

{- |
The Key Signature specifies a mode, either major or minor.
-}
data Mode = Major | Minor
            deriving (Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show, Mode -> Mode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, Eq Mode
Mode -> Mode -> Bool
Mode -> Mode -> Ordering
Mode -> Mode -> Mode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmax :: Mode -> Mode -> Mode
>= :: Mode -> Mode -> Bool
$c>= :: Mode -> Mode -> Bool
> :: Mode -> Mode -> Bool
$c> :: Mode -> Mode -> Bool
<= :: Mode -> Mode -> Bool
$c<= :: Mode -> Mode -> Bool
< :: Mode -> Mode -> Bool
$c< :: Mode -> Mode -> Bool
compare :: Mode -> Mode -> Ordering
$ccompare :: Mode -> Mode -> Ordering
Ord, Ord Mode
(Mode, Mode) -> Int
(Mode, Mode) -> [Mode]
(Mode, Mode) -> Mode -> Bool
(Mode, Mode) -> Mode -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Mode, Mode) -> Int
$cunsafeRangeSize :: (Mode, Mode) -> Int
rangeSize :: (Mode, Mode) -> Int
$crangeSize :: (Mode, Mode) -> Int
inRange :: (Mode, Mode) -> Mode -> Bool
$cinRange :: (Mode, Mode) -> Mode -> Bool
unsafeIndex :: (Mode, Mode) -> Mode -> Int
$cunsafeIndex :: (Mode, Mode) -> Mode -> Int
index :: (Mode, Mode) -> Mode -> Int
$cindex :: (Mode, Mode) -> Mode -> Int
range :: (Mode, Mode) -> [Mode]
$crange :: (Mode, Mode) -> [Mode]
Ix, Int -> Mode
Mode -> Int
Mode -> [Mode]
Mode -> Mode
Mode -> Mode -> [Mode]
Mode -> Mode -> Mode -> [Mode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
$cenumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
enumFromTo :: Mode -> Mode -> [Mode]
$cenumFromTo :: Mode -> Mode -> [Mode]
enumFromThen :: Mode -> Mode -> [Mode]
$cenumFromThen :: Mode -> Mode -> [Mode]
enumFrom :: Mode -> [Mode]
$cenumFrom :: Mode -> [Mode]
fromEnum :: Mode -> Int
$cfromEnum :: Mode -> Int
toEnum :: Int -> Mode
$ctoEnum :: Int -> Mode
pred :: Mode -> Mode
$cpred :: Mode -> Mode
succ :: Mode -> Mode
$csucc :: Mode -> Mode
Enum, Mode
forall a. a -> a -> Bounded a
maxBound :: Mode
$cmaxBound :: Mode
minBound :: Mode
$cminBound :: Mode
Bounded)


instance Random Mode where
   random :: forall g. RandomGen g => g -> (Mode, g)
random  = forall a g. (Enum a, Bounded a, RandomGen g) => g -> (a, g)
boundedEnumRandom
   randomR :: forall g. RandomGen g => (Mode, Mode) -> g -> (Mode, g)
randomR = forall a g. (Enum a, RandomGen g) => (a, a) -> g -> (a, g)
enumRandomR

instance Arbitrary Mode where
   arbitrary :: Gen Mode
arbitrary = forall a. (Enum a, Bounded a, Random a) => Gen a
chooseEnum





keyName :: Mode -> Accidentals -> String

keyName :: Mode -> Accidentals -> String
keyName Mode
Major (Accidentals (-7)) = String
"cf"
keyName Mode
Major (Accidentals (-6)) = String
"gf"
keyName Mode
Major (Accidentals (-5)) = String
"df"
keyName Mode
Major (Accidentals (-4)) = String
"af"
keyName Mode
Major (Accidentals (-3)) = String
"ef"
keyName Mode
Major (Accidentals (-2)) = String
"bf"
keyName Mode
Major (Accidentals (-1)) = String
"f"
keyName Mode
Major (Accidentals   Int
0)  = String
"c"
keyName Mode
Major (Accidentals   Int
1)  = String
"g"
keyName Mode
Major (Accidentals   Int
2)  = String
"d"
keyName Mode
Major (Accidentals   Int
3)  = String
"a"
keyName Mode
Major (Accidentals   Int
4)  = String
"e"
keyName Mode
Major (Accidentals   Int
5)  = String
"b"
keyName Mode
Major (Accidentals   Int
6)  = String
"fs"
keyName Mode
Major (Accidentals   Int
7)  = String
"cs"

keyName Mode
Minor (Accidentals (-7)) = String
"af"
keyName Mode
Minor (Accidentals (-6)) = String
"ef"
keyName Mode
Minor (Accidentals (-5)) = String
"bf"
keyName Mode
Minor (Accidentals (-4)) = String
"f"
keyName Mode
Minor (Accidentals (-3)) = String
"c"
keyName Mode
Minor (Accidentals (-2)) = String
"g"
keyName Mode
Minor (Accidentals (-1)) = String
"d"
keyName Mode
Minor (Accidentals   Int
0)  = String
"a"
keyName Mode
Minor (Accidentals   Int
1)  = String
"e"
keyName Mode
Minor (Accidentals   Int
2)  = String
"b"
keyName Mode
Minor (Accidentals   Int
3)  = String
"fs"
keyName Mode
Minor (Accidentals   Int
4)  = String
"cs"
keyName Mode
Minor (Accidentals   Int
5)  = String
"gs"
keyName Mode
Minor (Accidentals   Int
6)  = String
"ds"
keyName Mode
Minor (Accidentals   Int
7)  = String
"as"

keyName Mode
_ (Accidentals Int
n) =
   if Int
nforall a. Ord a => a -> a -> Bool
<Int
0
     then forall a. Show a => a -> String
show (-Int
n) forall a. [a] -> [a] -> [a]
++ String
" flats"
     else forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" sharps"


{- |
Accidentals as used in key signature.
-}
newtype Accidentals = Accidentals Int
           deriving (Int -> Accidentals -> ShowS
[Accidentals] -> ShowS
Accidentals -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Accidentals] -> ShowS
$cshowList :: [Accidentals] -> ShowS
show :: Accidentals -> String
$cshow :: Accidentals -> String
showsPrec :: Int -> Accidentals -> ShowS
$cshowsPrec :: Int -> Accidentals -> ShowS
Show, Accidentals -> Accidentals -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Accidentals -> Accidentals -> Bool
$c/= :: Accidentals -> Accidentals -> Bool
== :: Accidentals -> Accidentals -> Bool
$c== :: Accidentals -> Accidentals -> Bool
Eq, Eq Accidentals
Accidentals -> Accidentals -> Bool
Accidentals -> Accidentals -> Ordering
Accidentals -> Accidentals -> Accidentals
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Accidentals -> Accidentals -> Accidentals
$cmin :: Accidentals -> Accidentals -> Accidentals
max :: Accidentals -> Accidentals -> Accidentals
$cmax :: Accidentals -> Accidentals -> Accidentals
>= :: Accidentals -> Accidentals -> Bool
$c>= :: Accidentals -> Accidentals -> Bool
> :: Accidentals -> Accidentals -> Bool
$c> :: Accidentals -> Accidentals -> Bool
<= :: Accidentals -> Accidentals -> Bool
$c<= :: Accidentals -> Accidentals -> Bool
< :: Accidentals -> Accidentals -> Bool
$c< :: Accidentals -> Accidentals -> Bool
compare :: Accidentals -> Accidentals -> Ordering
$ccompare :: Accidentals -> Accidentals -> Ordering
Ord, Ord Accidentals
(Accidentals, Accidentals) -> Int
(Accidentals, Accidentals) -> [Accidentals]
(Accidentals, Accidentals) -> Accidentals -> Bool
(Accidentals, Accidentals) -> Accidentals -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Accidentals, Accidentals) -> Int
$cunsafeRangeSize :: (Accidentals, Accidentals) -> Int
rangeSize :: (Accidentals, Accidentals) -> Int
$crangeSize :: (Accidentals, Accidentals) -> Int
inRange :: (Accidentals, Accidentals) -> Accidentals -> Bool
$cinRange :: (Accidentals, Accidentals) -> Accidentals -> Bool
unsafeIndex :: (Accidentals, Accidentals) -> Accidentals -> Int
$cunsafeIndex :: (Accidentals, Accidentals) -> Accidentals -> Int
index :: (Accidentals, Accidentals) -> Accidentals -> Int
$cindex :: (Accidentals, Accidentals) -> Accidentals -> Int
range :: (Accidentals, Accidentals) -> [Accidentals]
$crange :: (Accidentals, Accidentals) -> [Accidentals]
Ix)

instance Bounded Accidentals where
   minBound :: Accidentals
minBound = Int -> Accidentals
Accidentals (-Int
7)
   maxBound :: Accidentals
maxBound = Int -> Accidentals
Accidentals Int
7

instance Enum Accidentals where
   fromEnum :: Accidentals -> Int
fromEnum (Accidentals Int
n) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
   toEnum :: Int -> Accidentals
toEnum = forall a.
(Bounded a, Ord a, Show a) =>
String -> (Int -> a) -> Int -> a
checkRange String
"Accidentals" (Int -> Accidentals
Accidentals forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Random Accidentals where
   random :: forall g. RandomGen g => g -> (Accidentals, g)
random  = forall a g. (Enum a, Bounded a, RandomGen g) => g -> (a, g)
boundedEnumRandom
   randomR :: forall g.
RandomGen g =>
(Accidentals, Accidentals) -> g -> (Accidentals, g)
randomR = forall a g. (Enum a, RandomGen g) => (a, a) -> g -> (a, g)
enumRandomR

instance Arbitrary Accidentals where
   arbitrary :: Gen Accidentals
arbitrary = forall a. (Enum a, Bounded a, Random a) => Gen a
chooseEnum




major, minor :: Accidentals -> T
major :: Accidentals -> T
major = Mode -> Accidentals -> T
Cons Mode
Major
minor :: Accidentals -> T
minor = Mode -> Accidentals -> T
Cons Mode
Minor

cfMajor, gfMajor, dfMajor, afMajor, efMajor,
  bfMajor, fMajor, cMajor, gMajor, dMajor, aMajor,
  eMajor, bMajor, fsMajor, csMajor :: T

afMinor, efMinor, bfMinor, fMinor, cMinor,
  gMinor, dMinor, aMinor, eMinor, bMinor, fsMinor,
  csMinor, gsMinor, dsMinor, asMinor :: T

cfMajor :: T
cfMajor = Accidentals -> T
major (Int -> Accidentals
Accidentals (-Int
7))
gfMajor :: T
gfMajor = Accidentals -> T
major (Int -> Accidentals
Accidentals (-Int
6))
dfMajor :: T
dfMajor = Accidentals -> T
major (Int -> Accidentals
Accidentals (-Int
5))
afMajor :: T
afMajor = Accidentals -> T
major (Int -> Accidentals
Accidentals (-Int
4))
efMajor :: T
efMajor = Accidentals -> T
major (Int -> Accidentals
Accidentals (-Int
3))
bfMajor :: T
bfMajor = Accidentals -> T
major (Int -> Accidentals
Accidentals (-Int
2))
fMajor :: T
fMajor  = Accidentals -> T
major (Int -> Accidentals
Accidentals (-Int
1))
cMajor :: T
cMajor  = Accidentals -> T
major (Int -> Accidentals
Accidentals   Int
0)
gMajor :: T
gMajor  = Accidentals -> T
major (Int -> Accidentals
Accidentals   Int
1)
dMajor :: T
dMajor  = Accidentals -> T
major (Int -> Accidentals
Accidentals   Int
2)
aMajor :: T
aMajor  = Accidentals -> T
major (Int -> Accidentals
Accidentals   Int
3)
eMajor :: T
eMajor  = Accidentals -> T
major (Int -> Accidentals
Accidentals   Int
4)
bMajor :: T
bMajor  = Accidentals -> T
major (Int -> Accidentals
Accidentals   Int
5)
fsMajor :: T
fsMajor = Accidentals -> T
major (Int -> Accidentals
Accidentals   Int
6)
csMajor :: T
csMajor = Accidentals -> T
major (Int -> Accidentals
Accidentals   Int
7)

afMinor :: T
afMinor = Accidentals -> T
minor (Int -> Accidentals
Accidentals (-Int
7))
efMinor :: T
efMinor = Accidentals -> T
minor (Int -> Accidentals
Accidentals (-Int
6))
bfMinor :: T
bfMinor = Accidentals -> T
minor (Int -> Accidentals
Accidentals (-Int
5))
fMinor :: T
fMinor  = Accidentals -> T
minor (Int -> Accidentals
Accidentals (-Int
4))
cMinor :: T
cMinor  = Accidentals -> T
minor (Int -> Accidentals
Accidentals (-Int
3))
gMinor :: T
gMinor  = Accidentals -> T
minor (Int -> Accidentals
Accidentals (-Int
2))
dMinor :: T
dMinor  = Accidentals -> T
minor (Int -> Accidentals
Accidentals (-Int
1))
aMinor :: T
aMinor  = Accidentals -> T
minor (Int -> Accidentals
Accidentals   Int
0)
eMinor :: T
eMinor  = Accidentals -> T
minor (Int -> Accidentals
Accidentals   Int
1)
bMinor :: T
bMinor  = Accidentals -> T
minor (Int -> Accidentals
Accidentals   Int
2)
fsMinor :: T
fsMinor = Accidentals -> T
minor (Int -> Accidentals
Accidentals   Int
3)
csMinor :: T
csMinor = Accidentals -> T
minor (Int -> Accidentals
Accidentals   Int
4)
gsMinor :: T
gsMinor = Accidentals -> T
minor (Int -> Accidentals
Accidentals   Int
5)
dsMinor :: T
dsMinor = Accidentals -> T
minor (Int -> Accidentals
Accidentals   Int
6)
asMinor :: T
asMinor = Accidentals -> T
minor (Int -> Accidentals
Accidentals   Int
7)


get :: (Parser.C parser) => Parser.Fragile parser T
get :: forall (parser :: * -> *). C parser => Fragile parser T
get = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (forall a b c. (a -> b -> c) -> b -> a -> c
flip Mode -> Accidentals -> T
Cons) forall (parser :: * -> *). C parser => Fragile parser Accidentals
getAccidentals forall (parser :: * -> *) enum.
(C parser, Enum enum, Bounded enum) =>
Fragile parser enum
getEnum

getAccidentals :: (Parser.C parser) => Parser.Fragile parser Accidentals
getAccidentals :: forall (parser :: * -> *). C parser => Fragile parser Accidentals
getAccidentals =
   forall (parser :: * -> *) enum.
(C parser, Enum enum, Bounded enum) =>
Int -> Fragile parser enum
makeEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> a
id :: Int8 -> Int8) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (parser :: * -> *). C parser => Fragile parser Word8
getByte

toBytes :: T -> [Int]
toBytes :: T -> [Int]
toBytes (Cons Mode
mi Accidentals
sf) = [forall a. Enum a => a -> Int
fromEnum Accidentals
sf, forall a. Enum a => a -> Int
fromEnum Mode
mi]