-- |
-- 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 FlexibleInstances #-}

module DobutokO.Sound.Effects.Delay where

import Data.List (intersperse)
import DobutokO.Sound.Effects.Timespec

data Delay a = D [a] deriving Delay a -> Delay a -> Bool
(Delay a -> Delay a -> Bool)
-> (Delay a -> Delay a -> Bool) -> Eq (Delay a)
forall a. Eq a => Delay a -> Delay a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Delay a -> Delay a -> Bool
$c/= :: forall a. Eq a => Delay a -> Delay a -> Bool
== :: Delay a -> Delay a -> Bool
$c== :: forall a. Eq a => Delay a -> Delay a -> Bool
Eq

instance Show (Delay TSpecification) where
  show :: Delay TSpecification -> String
show (D [TSpecification]
xs) 
    | [TSpecification] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TSpecification]
xs = []
    | Bool
otherwise = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"delay ",[String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String)
-> ([TSpecification] -> [String]) -> [TSpecification] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" " ([String] -> [String])
-> ([TSpecification] -> [String]) -> [TSpecification] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TSpecification -> String) -> [TSpecification] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TSpecification -> String
forall a. Show a => a -> String
show ([TSpecification] -> String) -> [TSpecification] -> String
forall a b. (a -> b) -> a -> b
$ [TSpecification]
xs]

type Dlay = Delay TSpecification

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

delaySet1 :: [TSpecification] -> Dlay
delaySet1 :: [TSpecification] -> Delay TSpecification
delaySet1 = [TSpecification] -> Delay TSpecification
forall a. [a] -> Delay a
D

showDlQ :: Dlay -> [String]
showDlQ :: Delay TSpecification -> [String]
showDlQ = String -> [String]
words (String -> [String])
-> (Delay TSpecification -> String)
-> Delay TSpecification
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delay TSpecification -> String
forall a. Show a => a -> String
show