-- |
-- Module      :  DobutokO.Sound.Effects.Delay
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Helps to create experimental music. 
-- Can be used for applying the SoX \"delay\" effect. 
-- 

{-# OPTIONS_GHC -threaded #-}
{-# LANGUAGE CPP, FlexibleInstances #-}

module DobutokO.Sound.Effects.Delay where

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import GHC.Base (mconcat)
#endif
#endif
import Numeric (showFFloat)
import Data.List (intersperse)
import DobutokO.Sound.Effects.Timespec

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif

data Delay a = D [a] deriving Eq

instance Show (Delay TSpecification) where
  show (D xs)
    | null xs = []
    | otherwise = mconcat ["delay ",mconcat . intersperse " " . map show $ xs]

type Dlay = Delay TSpecification

delay1 :: Dlay -> [TSpecification]
delay1 (D xs) = xs

showDlQ :: Dlay -> [String]
showDlQ = words . show