-- -fno-warn-typed-holes
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Music.Prelude hiding ((</>))
import qualified Music.Score
import qualified System.Process



-- mn'  = "(a (b c)) (> gs (a b)) ((c e d c) %-1d) %-2d"
dot x y = stretchTo 1 (stretch 3 x <> stretch 1 y)
mn'' = (stretchTo 1.mconcat)[(stretchTo 1.mconcat)[a,(stretchTo 1.mconcat)[b,c]],(stretchTo 1.mconcat)[gs `dot` (stretchTo 1.mconcat)[a,b]]]



mn = scat [a^*2,b,c',d',gs^*2,scat[a,b]^/2]^/4
cn = (\x -> x |> downDiatonic c 1 x |> (downDiatonic c 2 x)) $ scat [c',e',d',c']^/8
s  = mn |> cn
m  = set (pitches'.mapped.rel c._alteration) 0 $ upDiatonic c 2 s


-- Expositions
ex1 = delay 2 (up _P5 s)   </> s
ex2 = delay 2 (down _P4 s) </> s
ex3 = delay 2 (up _P5 m)   </> m
ex4 = delay 2 (down _P4 m) </> m
ex5 = delay 2 (up _P5 s)   </> s

-- Interludes
il = times 8 $ scat [c',e',d',c']^/8

music = scat [ex1,il,ex2,il,ex3,il,ex4,ex5]


main = open $ over parts' id $ asScore music























-- |
-- Parallel composition preserving parts.
--
-- If the part of a and b differ, compose using (<>).
-- If the part of a and b equal, the contents of a and b are placed in section 1 2 and section 2 2 respectively.
--
-- TODO handle subsections correctly. I.e. the parts must not only be distinct but noone must be a superset of the other
-- (what's the terminology for this?).
-- For an unexpected result, see
-- >>> foldl (</>) mempty [c,d,e,f,g]
--
(<<>) = (</>)

(</>) :: (HasParts' a, Semigroup a, Music.Score.Part a ~ Part) => a -> a -> a
a </> b = set parts' pa a <> set parts' pb b
  where
    (pa, pb) = case (a^?parts, b^?parts) of
        (Nothing,Nothing) -> (mempty, mempty)
        (Just x, Nothing) -> (x, mempty)
        (Nothing,Just x)  -> (mempty, x)
        (Just x, Just y)  -> if x /= y then (x, y) else divide2 x
    divide2 a = let [x,y] = divide 2 a in (x,y)
    
    -- if equal
    -- [pa',pb'] = divide 2 pa

upDiatonic o n = over (pitches'.mapped) (upDiatonicP o n)
downDiatonic o n = over (pitches'.mapped) (downDiatonicP o n)

rel o = iso (\p -> p .-. o) (\v -> o .+^ v)


openAudio x = do
    void $ writeMidi "test.mid" $ x
    void $ System.Process.system "timidity -Ow test.mid"
    void $ System.Process.system "open -a Audacity test.wav"