-- |
-- Module      :  Composition.Sound.Datatype 
-- Copyright   :  (c) OleksandrZhabenko 2024
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Inspired by the video by the link:
-- https://www.youtube.com/watch?v=rhgt3lZ1RUU

-- {-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Composition.Sound.Datatype 


where

import GHC.Base
import Text.Show
import Text.Read

{-| A most general datatype that is intended to represent an excerpt of a part of a musical instrument through the entire work. The values with equal 'group' belong to the one music phrase. 'freepars' are used to classify musical work and to provide general creative intentions for it. Usually it is a complex datatype with some inner structure so that it can be used efficiently and creatively enough.
 
-}
data Instrument a b c d e f g = Ins {
  forall a b c d e f g. Instrument a b c d e f g -> a
group :: a,
  forall a b c d e f g. Instrument a b c d e f g -> b
notedata :: b,
  forall a b c d e f g. Instrument a b c d e f g -> c
timing :: c,
  forall a b c d e f g. Instrument a b c d e f g -> d
parallel :: d,
  forall a b c d e f g. Instrument a b c d e f g -> e
modulation :: e,
  forall a b c d e f g. Instrument a b c d e f g -> f
specifics :: f,
  forall a b c d e f g. Instrument a b c d e f g -> g
freepars :: g
} deriving (Instrument a b c d e f g -> Instrument a b c d e f g -> Bool
(Instrument a b c d e f g -> Instrument a b c d e f g -> Bool)
-> (Instrument a b c d e f g -> Instrument a b c d e f g -> Bool)
-> Eq (Instrument a b c d e f g)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c d e f g.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g) =>
Instrument a b c d e f g -> Instrument a b c d e f g -> Bool
$c== :: forall a b c d e f g.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g) =>
Instrument a b c d e f g -> Instrument a b c d e f g -> Bool
== :: Instrument a b c d e f g -> Instrument a b c d e f g -> Bool
$c/= :: forall a b c d e f g.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g) =>
Instrument a b c d e f g -> Instrument a b c d e f g -> Bool
/= :: Instrument a b c d e f g -> Instrument a b c d e f g -> Bool
Eq, Int -> Instrument a b c d e f g -> ShowS
[Instrument a b c d e f g] -> ShowS
Instrument a b c d e f g -> String
(Int -> Instrument a b c d e f g -> ShowS)
-> (Instrument a b c d e f g -> String)
-> ([Instrument a b c d e f g] -> ShowS)
-> Show (Instrument a b c d e f g)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b c d e f g.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g) =>
Int -> Instrument a b c d e f g -> ShowS
forall a b c d e f g.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g) =>
[Instrument a b c d e f g] -> ShowS
forall a b c d e f g.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g) =>
Instrument a b c d e f g -> String
$cshowsPrec :: forall a b c d e f g.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g) =>
Int -> Instrument a b c d e f g -> ShowS
showsPrec :: Int -> Instrument a b c d e f g -> ShowS
$cshow :: forall a b c d e f g.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g) =>
Instrument a b c d e f g -> String
show :: Instrument a b c d e f g -> String
$cshowList :: forall a b c d e f g.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g) =>
[Instrument a b c d e f g] -> ShowS
showList :: [Instrument a b c d e f g] -> ShowS
Show, ReadPrec [Instrument a b c d e f g]
ReadPrec (Instrument a b c d e f g)
Int -> ReadS (Instrument a b c d e f g)
ReadS [Instrument a b c d e f g]
(Int -> ReadS (Instrument a b c d e f g))
-> ReadS [Instrument a b c d e f g]
-> ReadPrec (Instrument a b c d e f g)
-> ReadPrec [Instrument a b c d e f g]
-> Read (Instrument a b c d e f g)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b c d e f g.
(Read a, Read b, Read c, Read d, Read e, Read f, Read g) =>
ReadPrec [Instrument a b c d e f g]
forall a b c d e f g.
(Read a, Read b, Read c, Read d, Read e, Read f, Read g) =>
ReadPrec (Instrument a b c d e f g)
forall a b c d e f g.
(Read a, Read b, Read c, Read d, Read e, Read f, Read g) =>
Int -> ReadS (Instrument a b c d e f g)
forall a b c d e f g.
(Read a, Read b, Read c, Read d, Read e, Read f, Read g) =>
ReadS [Instrument a b c d e f g]
$creadsPrec :: forall a b c d e f g.
(Read a, Read b, Read c, Read d, Read e, Read f, Read g) =>
Int -> ReadS (Instrument a b c d e f g)
readsPrec :: Int -> ReadS (Instrument a b c d e f g)
$creadList :: forall a b c d e f g.
(Read a, Read b, Read c, Read d, Read e, Read f, Read g) =>
ReadS [Instrument a b c d e f g]
readList :: ReadS [Instrument a b c d e f g]
$creadPrec :: forall a b c d e f g.
(Read a, Read b, Read c, Read d, Read e, Read f, Read g) =>
ReadPrec (Instrument a b c d e f g)
readPrec :: ReadPrec (Instrument a b c d e f g)
$creadListPrec :: forall a b c d e f g.
(Read a, Read b, Read c, Read d, Read e, Read f, Read g) =>
ReadPrec [Instrument a b c d e f g]
readListPrec :: ReadPrec [Instrument a b c d e f g]
Read) 

-- | Is intended to be generally used as 'notedata' from the 'Instrument'.
data Notedata a = Note a | Inter a a | Chord a a a | Chord7 a a a a | Chord9 a a a a a |  Chord11 a a a a a a deriving (Notedata a -> Notedata a -> Bool
(Notedata a -> Notedata a -> Bool)
-> (Notedata a -> Notedata a -> Bool) -> Eq (Notedata a)
forall a. Eq a => Notedata a -> Notedata a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Notedata a -> Notedata a -> Bool
== :: Notedata a -> Notedata a -> Bool
$c/= :: forall a. Eq a => Notedata a -> Notedata a -> Bool
/= :: Notedata a -> Notedata a -> Bool
Eq, ReadPrec [Notedata a]
ReadPrec (Notedata a)
Int -> ReadS (Notedata a)
ReadS [Notedata a]
(Int -> ReadS (Notedata a))
-> ReadS [Notedata a]
-> ReadPrec (Notedata a)
-> ReadPrec [Notedata a]
-> Read (Notedata a)
forall a. Read a => ReadPrec [Notedata a]
forall a. Read a => ReadPrec (Notedata a)
forall a. Read a => Int -> ReadS (Notedata a)
forall a. Read a => ReadS [Notedata a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Notedata a)
readsPrec :: Int -> ReadS (Notedata a)
$creadList :: forall a. Read a => ReadS [Notedata a]
readList :: ReadS [Notedata a]
$creadPrec :: forall a. Read a => ReadPrec (Notedata a)
readPrec :: ReadPrec (Notedata a)
$creadListPrec :: forall a. Read a => ReadPrec [Notedata a]
readListPrec :: ReadPrec [Notedata a]
Read, Int -> Notedata a -> ShowS
[Notedata a] -> ShowS
Notedata a -> String
(Int -> Notedata a -> ShowS)
-> (Notedata a -> String)
-> ([Notedata a] -> ShowS)
-> Show (Notedata a)
forall a. Show a => Int -> Notedata a -> ShowS
forall a. Show a => [Notedata a] -> ShowS
forall a. Show a => Notedata a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Notedata a -> ShowS
showsPrec :: Int -> Notedata a -> ShowS
$cshow :: forall a. Show a => Notedata a -> String
show :: Notedata a -> String
$cshowList :: forall a. Show a => [Notedata a] -> ShowS
showList :: [Notedata a] -> ShowS
Show) 

-- | Is intended to be generally used as 'parallel' from the 'Instrument' e. g. for the solo piano musical work.
data ParallelClassic a = LeftPar a | RightPar a | LeftSeq a | RightSeq a deriving (ParallelClassic a -> ParallelClassic a -> Bool
(ParallelClassic a -> ParallelClassic a -> Bool)
-> (ParallelClassic a -> ParallelClassic a -> Bool)
-> Eq (ParallelClassic a)
forall a. Eq a => ParallelClassic a -> ParallelClassic a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ParallelClassic a -> ParallelClassic a -> Bool
== :: ParallelClassic a -> ParallelClassic a -> Bool
$c/= :: forall a. Eq a => ParallelClassic a -> ParallelClassic a -> Bool
/= :: ParallelClassic a -> ParallelClassic a -> Bool
Eq, ReadPrec [ParallelClassic a]
ReadPrec (ParallelClassic a)
Int -> ReadS (ParallelClassic a)
ReadS [ParallelClassic a]
(Int -> ReadS (ParallelClassic a))
-> ReadS [ParallelClassic a]
-> ReadPrec (ParallelClassic a)
-> ReadPrec [ParallelClassic a]
-> Read (ParallelClassic a)
forall a. Read a => ReadPrec [ParallelClassic a]
forall a. Read a => ReadPrec (ParallelClassic a)
forall a. Read a => Int -> ReadS (ParallelClassic a)
forall a. Read a => ReadS [ParallelClassic a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (ParallelClassic a)
readsPrec :: Int -> ReadS (ParallelClassic a)
$creadList :: forall a. Read a => ReadS [ParallelClassic a]
readList :: ReadS [ParallelClassic a]
$creadPrec :: forall a. Read a => ReadPrec (ParallelClassic a)
readPrec :: ReadPrec (ParallelClassic a)
$creadListPrec :: forall a. Read a => ReadPrec [ParallelClassic a]
readListPrec :: ReadPrec [ParallelClassic a]
Read, Int -> ParallelClassic a -> ShowS
[ParallelClassic a] -> ShowS
ParallelClassic a -> String
(Int -> ParallelClassic a -> ShowS)
-> (ParallelClassic a -> String)
-> ([ParallelClassic a] -> ShowS)
-> Show (ParallelClassic a)
forall a. Show a => Int -> ParallelClassic a -> ShowS
forall a. Show a => [ParallelClassic a] -> ShowS
forall a. Show a => ParallelClassic a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ParallelClassic a -> ShowS
showsPrec :: Int -> ParallelClassic a -> ShowS
$cshow :: forall a. Show a => ParallelClassic a -> String
show :: ParallelClassic a -> String
$cshowList :: forall a. Show a => [ParallelClassic a] -> ShowS
showList :: [ParallelClassic a] -> ShowS
Show)