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

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

module DobutokO.Sound.Effects.Repeat 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

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

data Count a = I | O1 | Ct a deriving Count a -> Count a -> Bool
(Count a -> Count a -> Bool)
-> (Count a -> Count a -> Bool) -> Eq (Count a)
forall a. Eq a => Count a -> Count a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Count a -> Count a -> Bool
$c/= :: forall a. Eq a => Count a -> Count a -> Bool
== :: Count a -> Count a -> Bool
$c== :: forall a. Eq a => Count a -> Count a -> Bool
Eq

instance Show (Count Int) where
  show :: Count Int -> String
show Count Int
I = String
"- "
  show Count Int
O1 = String
""
  show (Ct Int
n) 
   | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = String
"- "
   | Bool
otherwise = Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "

type CountR = Count Int  

data Repeat a = Rpt a deriving Repeat a -> Repeat a -> Bool
(Repeat a -> Repeat a -> Bool)
-> (Repeat a -> Repeat a -> Bool) -> Eq (Repeat a)
forall a. Eq a => Repeat a -> Repeat a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Repeat a -> Repeat a -> Bool
$c/= :: forall a. Eq a => Repeat a -> Repeat a -> Bool
== :: Repeat a -> Repeat a -> Bool
$c== :: forall a. Eq a => Repeat a -> Repeat a -> Bool
Eq

instance Show (Repeat CountR) where
  show :: Repeat (Count Int) -> String
show (Rpt Count Int
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"repeat ",Count Int -> String
forall a. Show a => a -> String
show Count Int
x]

repeat1 :: Repeat a -> a
repeat1 :: Repeat a -> a
repeat1 (Rpt a
x) = a
x

repeatSet1 :: a -> Repeat a
repeatSet1 :: a -> Repeat a
repeatSet1 = a -> Repeat a
forall a. a -> Repeat a
Rpt

type Repeat1 = Repeat CountR

showRptQ :: Repeat1 -> [String]
showRptQ :: Repeat (Count Int) -> [String]
showRptQ = String -> [String]
words (String -> [String])
-> (Repeat (Count Int) -> String) -> Repeat (Count Int) -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repeat (Count Int) -> String
forall a. Show a => a -> String
show