{-# LANGUAGE OverloadedStrings, FlexibleContexts, ConstraintKinds, TypeFamilies, RankNTypes #-}

import Music.Score (pitch) -- TODO
import qualified Music.Score
import Music.Prelude.Standard hiding (pitch, open, play, openAndPlay)
import Control.Concurrent.Async
import Control.Applicative
import System.Process (system)
import qualified Data.Foldable
import Control.Lens hiding (Parts)
import Data.Default -- debug
import Math.OEIS

{-    
    A serial composition using sequences from the OEIS (http://oeis.org/)

    TODO optimize extendSequence etc (use local caching, possibly `unamb`)
-}

main :: IO ()
main = openMusicXml music

ensemble :: [Part]
ensemble = (divide 4 (tutti violin)) <> (divide 2 (tutti viola)) <> (divide 2 (tutti cello)) <> [tutti doubleBass]

type Scale = Integer -> Interval
scale :: Scale
scale n = case n `mod` 6 of
  0 -> _P1
  1 -> _M2
  2 -> _M3
  3 -> _A4
  4 -> _P5
  5 -> _M6

len = 90

seq1 :: Score Integer
seq1 = scat $ take len $ fmap return $ fmap (`mod` 6) $ Data.Foldable.toList $ extendSequence [2,1,1,2,2]
seq2 = scat $ take len $ fmap return $ fmap (`mod` 6) $ Data.Foldable.toList $ extendSequence [2,1,1,2,2,1]

-- Thue–Morse sequence
seq3 = scat $ take len $ fmap return $ fmap (`mod` 6) $ Data.Foldable.toList $ extendSequence [2,1,1,2,2,1,1]

music = pcat [(partNs 0 & up (m3^*2) & compress 6),
              (partNs 1 & up (m3^*1) & compress 5),
              (partNs 2 & compress 4)]
  & fmap (pitches' %~ normalize) & compress 4 & staccato

partNs n = part1 n <> part2 n <> part3 n
part1 n = asScore $ (parts' .~ (ensemble !! (0+3*n))) $ fmap (\x -> pitches' %~ (.+^ pure (scale x)) $ (c::Note)) $ seq1
part2 n = asScore $ (parts' .~ (ensemble !! (1+3*n))) $ fmap (\x -> pitches' %~ (.+^ pure (scale x)) $ (c::Note)) $ seq2
part3 n = asScore $ (parts' .~ (ensemble !! (2+3*n))) $ fmap (\x -> pitches' %~ (.+^ pure (scale x)) $ (c::Note)) $ seq3

-- instance Monoid Part where
--   mempty = def
-- instance Monoid p => Monad (PartT p) where
--   return x = PartT (mempty, x)











-- TODO remove Default 
{-
parts :: (Default (Music.Score.Part a), Traversable t, HasPart a) => Traversal' (t a) (Music.Score.Part a) 
parts = traverse . part

part :: (Default (Music.Score.Part a), HasPart a) => Lens' a (Music.Score.Part a)
part = lens getPart (flip setPart)

part_ :: HasSetPitch a b => Setter a b (Music.Score.Pitch a) (Music.Score.Pitch b)
part_ = sets __mapPitch
-}

class Normal a where
    normalize :: a -> a
instance Normal Pitch where
    normalize = relative c (spell usingSharps)
instance Normal a => Normal (Behavior a) where
    normalize = fmap normalize



merge xs ys = concatMap (\(x,y) -> [x,y]) $ xs `zip` ys

mapEvensOdds :: (a -> b) -> (a -> b) -> [a] -> [b]
mapEvensOdds f g xs = let

    evens [] = []
    evens (x:xs) = x:odds xs

    odds [] = []
    odds (x:xs)  = evens xs

    in take (length xs) $ map f (evens xs) `merge` map g (odds xs)


openAudacity :: Score Note -> IO ()    
openAudacity x = do
    void $ writeMidi "test.mid" $ x
    void $ system "timidity -Ow test.mid"
    void $ system "open -a Audacity test.wav"

openAudio :: Score Note -> IO ()    
openAudio x = do
    void $ writeMidi "test.mid" $ x
    void $ system "timidity -Ow test.mid"
    void $ system "open -a Audacity test.wav"

fixClefs :: Score Note -> Score Note
fixClefs = pcat . fmap (uncurry g) . extractParts'
    where
        g p x = clef (case defaultClef p of { 0 -> GClef; 1 -> CClef; 2 -> FClef } ) x

concurrently_ :: IO a -> IO b -> IO ()
concurrently_ = concurrentlyWith (\x y -> ())

concurrentlyWith :: (a -> b -> c) -> IO a -> IO b -> IO c
concurrentlyWith f x y = uncurry f <$> x `concurrently` y

play, open, openAndPlay :: Score Note -> IO ()   
tempo_ = 120
play x = openAudio $ stretch ((60*4)/tempo_) $ fixClefs $ x
open x = openLilypond' LyScoreFormat $ fixClefs $ x
openAndPlay x = play x `concurrently_` openMusicXml x