FComp-1.0.2: src/Main.hs

{-# LANGUAGE DataKinds                #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Main
-- Copyright   :  (c) 2010-2012 Universiteit Utrecht, 2012 University of Oxford
-- License     :  GPL3
--
-- Maintainer  :  bash@cs.uu.nl, jpm@cs.ox.ac.uk
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Summary: The main module, just for testing
--------------------------------------------------------------------------------

module Main where

-- Music stuff
import HarmTrace.Models.Generator
import HarmTrace.Models.Simple.Main
import HarmTrace.Accompany
import HarmTrace.Play
import HarmTrace.Base.MusicRep

import Test.QuickCheck              ( sample' )
import Data.Maybe                   ( fromJust )
import Data.Time.Clock              ( getCurrentTime )

--------------------------------------------------------------------------------
-- Temporary testing code for harmony generation
--------------------------------------------------------------------------------

{-
Generating goes as follows:
1) Generate the harmony
2) From there, generate the melody:
  2.1) Generate candidate melody notes from chords
  2.2) Trim these to remove bad candidates
  2.3) Pick one
  2.4) Embellish it
3) Combine the two, output
-}

testGen :: Gen Piece
testGen = fmap Piece gen
  where gen = fromJust (genGdefault ft undefined) :: Gen [Phrase MajMode]
        ft  = [("P_1",     0)
              ,("P_15",    0)
              ,("P_1451",  2)
              ,("D_1",     2)
              ,("D_5",     3)
              ,(":",       3)
              ,("S_3",     3)]

main :: IO ()
main = let k = Key (Note Nothing C) MajMode
           perform p = do so <- accompanyIO k p
                          t <- getCurrentTime
                          let fn = filter (/= ':') (show t) ++ ".mid"
                          print so
                          writeMIDI fn (songToMIDI so)
                          playMIDI (songToMIDI so)
       in sample' testGen >>= mapM_ perform