-- Copyright 2015 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# OPTIONS_HADDOCK not-home #-}
-- | Low-dependency basic types for derivation.
module Derive.ScoreT where
import qualified Control.DeepSeq as DeepSeq
import qualified Data.Hashable as Hashable
import qualified Data.String as String
import qualified Data.Text as Text

import qualified Util.Pretty as Pretty
import qualified Util.Serialize as Serialize
import qualified Derive.ShowVal as ShowVal
import qualified Perform.Pitch as Pitch
import qualified Perform.RealTime as RealTime
import qualified Perform.Signal as Signal

import qualified Ui.Id as Id
import qualified Ui.ScoreTime as ScoreTime

import           Global


-- | An Instrument is identified by a plain string.  This will be looked up in
-- the instrument db to get the backend specific Instrument type as well as
-- the backend itself, but things at the Derive layer and above don't care
-- about all that.
--
-- This should be a valid symbol as defined by 'Ui.Id.valid_symbol'.  This
-- way it can be parsed without quotes.
newtype Instrument = Instrument Text
    deriving (Instrument -> Instrument -> Bool
(Instrument -> Instrument -> Bool)
-> (Instrument -> Instrument -> Bool) -> Eq Instrument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Instrument -> Instrument -> Bool
$c/= :: Instrument -> Instrument -> Bool
== :: Instrument -> Instrument -> Bool
$c== :: Instrument -> Instrument -> Bool
Eq, Eq Instrument
Eq Instrument
-> (Instrument -> Instrument -> Ordering)
-> (Instrument -> Instrument -> Bool)
-> (Instrument -> Instrument -> Bool)
-> (Instrument -> Instrument -> Bool)
-> (Instrument -> Instrument -> Bool)
-> (Instrument -> Instrument -> Instrument)
-> (Instrument -> Instrument -> Instrument)
-> Ord Instrument
Instrument -> Instrument -> Bool
Instrument -> Instrument -> Ordering
Instrument -> Instrument -> Instrument
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Instrument -> Instrument -> Instrument
$cmin :: Instrument -> Instrument -> Instrument
max :: Instrument -> Instrument -> Instrument
$cmax :: Instrument -> Instrument -> Instrument
>= :: Instrument -> Instrument -> Bool
$c>= :: Instrument -> Instrument -> Bool
> :: Instrument -> Instrument -> Bool
$c> :: Instrument -> Instrument -> Bool
<= :: Instrument -> Instrument -> Bool
$c<= :: Instrument -> Instrument -> Bool
< :: Instrument -> Instrument -> Bool
$c< :: Instrument -> Instrument -> Bool
compare :: Instrument -> Instrument -> Ordering
$ccompare :: Instrument -> Instrument -> Ordering
Ord, Int -> Instrument -> ShowS
[Instrument] -> ShowS
Instrument -> String
(Int -> Instrument -> ShowS)
-> (Instrument -> String)
-> ([Instrument] -> ShowS)
-> Show Instrument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Instrument] -> ShowS
$cshowList :: [Instrument] -> ShowS
show :: Instrument -> String
$cshow :: Instrument -> String
showsPrec :: Int -> Instrument -> ShowS
$cshowsPrec :: Int -> Instrument -> ShowS
Show, ReadPrec [Instrument]
ReadPrec Instrument
Int -> ReadS Instrument
ReadS [Instrument]
(Int -> ReadS Instrument)
-> ReadS [Instrument]
-> ReadPrec Instrument
-> ReadPrec [Instrument]
-> Read Instrument
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Instrument]
$creadListPrec :: ReadPrec [Instrument]
readPrec :: ReadPrec Instrument
$creadPrec :: ReadPrec Instrument
readList :: ReadS [Instrument]
$creadList :: ReadS [Instrument]
readsPrec :: Int -> ReadS Instrument
$creadsPrec :: Int -> ReadS Instrument
Read, Eq Instrument
Eq Instrument
-> (Int -> Instrument -> Int)
-> (Instrument -> Int)
-> Hashable Instrument
Int -> Instrument -> Int
Instrument -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Instrument -> Int
$chash :: Instrument -> Int
hashWithSalt :: Int -> Instrument -> Int
$chashWithSalt :: Int -> Instrument -> Int
Hashable.Hashable, Instrument -> ()
(Instrument -> ()) -> NFData Instrument
forall a. (a -> ()) -> NFData a
rnf :: Instrument -> ()
$crnf :: Instrument -> ()
DeepSeq.NFData,
        Get Instrument
Putter Instrument
Putter Instrument -> Get Instrument -> Serialize Instrument
forall a. Putter a -> Get a -> Serialize a
get :: Get Instrument
$cget :: Get Instrument
put :: Putter Instrument
$cput :: Putter Instrument
Serialize.Serialize, String -> Instrument
(String -> Instrument) -> IsString Instrument
forall a. (String -> a) -> IsString a
fromString :: String -> Instrument
$cfromString :: String -> Instrument
String.IsString)

instrument_name :: Instrument -> Text
instrument_name :: Instrument -> Text
instrument_name (Instrument Text
s) = Text
s

empty_instrument :: Instrument
empty_instrument :: Instrument
empty_instrument = Text -> Instrument
Instrument Text
""

instance Pretty Instrument where pretty :: Instrument -> Text
pretty = Instrument -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val
instance ShowVal.ShowVal Instrument where
    show_val :: Instrument -> Text
show_val (Instrument Text
inst) = Text -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Text
inst

-- ** Control

-- | A control is an abstract parameter that influences derivation.  Some of
-- them affect performance and will be rendered as MIDI controls or note
-- parameters or whatever, while others may affect derivation (e.g. tempo) and
-- won't be seen by the backend at all.
--
-- A Control should be a valid identifier as defined by 'Ui.Id.valid_symbol'.
newtype Control = Control Text
    deriving (Control -> Control -> Bool
(Control -> Control -> Bool)
-> (Control -> Control -> Bool) -> Eq Control
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Control -> Control -> Bool
$c/= :: Control -> Control -> Bool
== :: Control -> Control -> Bool
$c== :: Control -> Control -> Bool
Eq, Eq Control
Eq Control
-> (Control -> Control -> Ordering)
-> (Control -> Control -> Bool)
-> (Control -> Control -> Bool)
-> (Control -> Control -> Bool)
-> (Control -> Control -> Bool)
-> (Control -> Control -> Control)
-> (Control -> Control -> Control)
-> Ord Control
Control -> Control -> Bool
Control -> Control -> Ordering
Control -> Control -> Control
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Control -> Control -> Control
$cmin :: Control -> Control -> Control
max :: Control -> Control -> Control
$cmax :: Control -> Control -> Control
>= :: Control -> Control -> Bool
$c>= :: Control -> Control -> Bool
> :: Control -> Control -> Bool
$c> :: Control -> Control -> Bool
<= :: Control -> Control -> Bool
$c<= :: Control -> Control -> Bool
< :: Control -> Control -> Bool
$c< :: Control -> Control -> Bool
compare :: Control -> Control -> Ordering
$ccompare :: Control -> Control -> Ordering
Ord, ReadPrec [Control]
ReadPrec Control
Int -> ReadS Control
ReadS [Control]
(Int -> ReadS Control)
-> ReadS [Control]
-> ReadPrec Control
-> ReadPrec [Control]
-> Read Control
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Control]
$creadListPrec :: ReadPrec [Control]
readPrec :: ReadPrec Control
$creadPrec :: ReadPrec Control
readList :: ReadS [Control]
$creadList :: ReadS [Control]
readsPrec :: Int -> ReadS Control
$creadsPrec :: Int -> ReadS Control
Read, Int -> Control -> ShowS
[Control] -> ShowS
Control -> String
(Int -> Control -> ShowS)
-> (Control -> String) -> ([Control] -> ShowS) -> Show Control
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Control] -> ShowS
$cshowList :: [Control] -> ShowS
show :: Control -> String
$cshow :: Control -> String
showsPrec :: Int -> Control -> ShowS
$cshowsPrec :: Int -> Control -> ShowS
Show, Control -> ()
(Control -> ()) -> NFData Control
forall a. (a -> ()) -> NFData a
rnf :: Control -> ()
$crnf :: Control -> ()
DeepSeq.NFData, Get Control
Putter Control
Putter Control -> Get Control -> Serialize Control
forall a. Putter a -> Get a -> Serialize a
get :: Get Control
$cget :: Get Control
put :: Putter Control
$cput :: Putter Control
Serialize.Serialize,
        String -> Control
(String -> Control) -> IsString Control
forall a. (String -> a) -> IsString a
fromString :: String -> Control
$cfromString :: String -> Control
String.IsString)

control_name :: Control -> Text
control_name :: Control -> Text
control_name (Control Text
name) = Text
name

instance Pretty Control where pretty :: Control -> Text
pretty = Control -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val
instance ShowVal.ShowVal Control where show_val :: Control -> Text
show_val (Control Text
c) = Char -> Text -> Text
Text.cons Char
'%' Text
c

-- | Use this constructor when making a Control from user input.  Literals
-- can use the IsString instance.
control :: Text -> Either Text Control
control :: Text -> Either Text Control
control Text
name
    | Text -> Bool
Text.null Text
name = Text -> Either Text Control
forall a b. a -> Either a b
Left Text
"empty control name"
    | Text -> Bool
Id.valid_symbol Text
name = Control -> Either Text Control
forall a b. b -> Either a b
Right (Control -> Either Text Control) -> Control -> Either Text Control
forall a b. (a -> b) -> a -> b
$ Text -> Control
Control Text
name
    | Bool
otherwise = Text -> Either Text Control
forall a b. a -> Either a b
Left (Text -> Either Text Control) -> Text -> Either Text Control
forall a b. (a -> b) -> a -> b
$ Text
"invalid characters in control: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
showt Text
name

unchecked_control :: Text -> Control
unchecked_control :: Text -> Control
unchecked_control = Text -> Control
Control

-- ** PControl

-- | The pitch control version of 'Control'.  Unlike Control, this is allowed
-- to be null, which is the name of the default pitch signal.
--
-- A PControl should be a valid identifier as defined by 'Ui.Id.valid_symbol',
-- except that its literal tracklang form starts with a @#@, to differentiate
-- from a Control.
newtype PControl = PControl Text
    deriving (PControl -> PControl -> Bool
(PControl -> PControl -> Bool)
-> (PControl -> PControl -> Bool) -> Eq PControl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PControl -> PControl -> Bool
$c/= :: PControl -> PControl -> Bool
== :: PControl -> PControl -> Bool
$c== :: PControl -> PControl -> Bool
Eq, Eq PControl
Eq PControl
-> (PControl -> PControl -> Ordering)
-> (PControl -> PControl -> Bool)
-> (PControl -> PControl -> Bool)
-> (PControl -> PControl -> Bool)
-> (PControl -> PControl -> Bool)
-> (PControl -> PControl -> PControl)
-> (PControl -> PControl -> PControl)
-> Ord PControl
PControl -> PControl -> Bool
PControl -> PControl -> Ordering
PControl -> PControl -> PControl
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PControl -> PControl -> PControl
$cmin :: PControl -> PControl -> PControl
max :: PControl -> PControl -> PControl
$cmax :: PControl -> PControl -> PControl
>= :: PControl -> PControl -> Bool
$c>= :: PControl -> PControl -> Bool
> :: PControl -> PControl -> Bool
$c> :: PControl -> PControl -> Bool
<= :: PControl -> PControl -> Bool
$c<= :: PControl -> PControl -> Bool
< :: PControl -> PControl -> Bool
$c< :: PControl -> PControl -> Bool
compare :: PControl -> PControl -> Ordering
$ccompare :: PControl -> PControl -> Ordering
Ord, ReadPrec [PControl]
ReadPrec PControl
Int -> ReadS PControl
ReadS [PControl]
(Int -> ReadS PControl)
-> ReadS [PControl]
-> ReadPrec PControl
-> ReadPrec [PControl]
-> Read PControl
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PControl]
$creadListPrec :: ReadPrec [PControl]
readPrec :: ReadPrec PControl
$creadPrec :: ReadPrec PControl
readList :: ReadS [PControl]
$creadList :: ReadS [PControl]
readsPrec :: Int -> ReadS PControl
$creadsPrec :: Int -> ReadS PControl
Read, Int -> PControl -> ShowS
[PControl] -> ShowS
PControl -> String
(Int -> PControl -> ShowS)
-> (PControl -> String) -> ([PControl] -> ShowS) -> Show PControl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PControl] -> ShowS
$cshowList :: [PControl] -> ShowS
show :: PControl -> String
$cshow :: PControl -> String
showsPrec :: Int -> PControl -> ShowS
$cshowsPrec :: Int -> PControl -> ShowS
Show, PControl -> ()
(PControl -> ()) -> NFData PControl
forall a. (a -> ()) -> NFData a
rnf :: PControl -> ()
$crnf :: PControl -> ()
DeepSeq.NFData, Get PControl
Putter PControl
Putter PControl -> Get PControl -> Serialize PControl
forall a. Putter a -> Get a -> Serialize a
get :: Get PControl
$cget :: Get PControl
put :: Putter PControl
$cput :: Putter PControl
Serialize.Serialize,
        String -> PControl
(String -> PControl) -> IsString PControl
forall a. (String -> a) -> IsString a
fromString :: String -> PControl
$cfromString :: String -> PControl
String.IsString)

pcontrol_name :: PControl -> Text
pcontrol_name :: PControl -> Text
pcontrol_name (PControl Text
name) = Text
name

default_pitch :: PControl
default_pitch :: PControl
default_pitch = PControl
""

instance Pretty PControl where pretty :: PControl -> Text
pretty = PControl -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val
instance ShowVal.ShowVal PControl where show_val :: PControl -> Text
show_val (PControl Text
c) = Char -> Text -> Text
Text.cons Char
'#' Text
c


-- | Use this constructor when making a PControl from user input.  Literals
-- can use the IsString instance.
pcontrol :: Text -> Either Text PControl
pcontrol :: Text -> Either Text PControl
pcontrol Text
name
    | Text -> Bool
Text.null Text
name Bool -> Bool -> Bool
|| Text -> Bool
Id.valid_symbol Text
name = PControl -> Either Text PControl
forall a b. b -> Either a b
Right (PControl -> Either Text PControl)
-> PControl -> Either Text PControl
forall a b. (a -> b) -> a -> b
$ Text -> PControl
PControl Text
name
    | Bool
otherwise = Text -> Either Text PControl
forall a b. a -> Either a b
Left (Text -> Either Text PControl) -> Text -> Either Text PControl
forall a b. (a -> b) -> a -> b
$ Text
"invalid characters in pitch control: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
showt Text
name

unchecked_pcontrol :: Text -> PControl
unchecked_pcontrol :: Text -> PControl
unchecked_pcontrol = Text -> PControl
PControl

-- | Parse either a Control or PControl.
parse_generic_control :: Text
    -> Either Text (Either Control PControl)
parse_generic_control :: Text -> Either Text (Either Control PControl)
parse_generic_control Text
name = case Text -> Maybe (Char, Text)
Text.uncons Text
name of
    Just (Char
'#', Text
rest) -> PControl -> Either Control PControl
forall a b. b -> Either a b
Right (PControl -> Either Control PControl)
-> Either Text PControl -> Either Text (Either Control PControl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text PControl
pcontrol Text
rest
    Maybe (Char, Text)
_ -> Control -> Either Control PControl
forall a b. a -> Either a b
Left (Control -> Either Control PControl)
-> Either Text Control -> Either Text (Either Control PControl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text Control
control Text
name


-- ** Type

-- | Tag for the type of the values in a control signal.
data Type = Untyped | Chromatic | Diatonic | Nn | Score | Real
    deriving (Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Int -> Type
Type -> Int
Type -> [Type]
Type -> Type
Type -> Type -> [Type]
Type -> Type -> Type -> [Type]
(Type -> Type)
-> (Type -> Type)
-> (Int -> Type)
-> (Type -> Int)
-> (Type -> [Type])
-> (Type -> Type -> [Type])
-> (Type -> Type -> [Type])
-> (Type -> Type -> Type -> [Type])
-> Enum Type
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Type -> Type -> Type -> [Type]
$cenumFromThenTo :: Type -> Type -> Type -> [Type]
enumFromTo :: Type -> Type -> [Type]
$cenumFromTo :: Type -> Type -> [Type]
enumFromThen :: Type -> Type -> [Type]
$cenumFromThen :: Type -> Type -> [Type]
enumFrom :: Type -> [Type]
$cenumFrom :: Type -> [Type]
fromEnum :: Type -> Int
$cfromEnum :: Type -> Int
toEnum :: Int -> Type
$ctoEnum :: Int -> Type
pred :: Type -> Type
$cpred :: Type -> Type
succ :: Type -> Type
$csucc :: Type -> Type
Enum, Eq Type
Eq Type
-> (Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
Ord, ReadPrec [Type]
ReadPrec Type
Int -> ReadS Type
ReadS [Type]
(Int -> ReadS Type)
-> ReadS [Type] -> ReadPrec Type -> ReadPrec [Type] -> Read Type
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Type]
$creadListPrec :: ReadPrec [Type]
readPrec :: ReadPrec Type
$creadPrec :: ReadPrec Type
readList :: ReadS [Type]
$creadList :: ReadS [Type]
readsPrec :: Int -> ReadS Type
$creadsPrec :: Int -> ReadS Type
Read, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show)

instance Pretty Type where pretty :: Type -> Text
pretty = Type -> Text
forall a. Show a => a -> Text
showt

instance Serialize.Serialize Type where
    put :: Putter Type
put = Putter Int
forall a. Serialize a => Putter a
Serialize.put Putter Int -> (Type -> Int) -> Putter Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Int
forall a. Enum a => a -> Int
fromEnum
    get :: Get Type
get = Int -> Type
forall a. Enum a => Int -> a
toEnum (Int -> Type) -> Get Int -> Get Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall a. Serialize a => Get a
Serialize.get

all_types :: [Type]
all_types :: [Type]
all_types = [Type
Chromatic, Type
Diatonic, Type
Nn, Type
Score, Type
Real, Type
Untyped]
    -- Untyped goes last because the parser tries them in order.

type_to_code :: Type -> Text
type_to_code :: Type -> Text
type_to_code Type
typ = case Type
typ of
    Type
Untyped -> Text
""
    Type
Chromatic -> Text
"c"
    Type
Diatonic -> Text
"d"
    Type
Nn -> Text
"nn"
    Type
Score -> Char -> Text
Text.singleton Char
ScoreTime.suffix -- t for time
    Type
Real -> Char -> Text
Text.singleton Char
RealTime.suffix -- s for seconds

code_to_type :: Text -> Maybe Type
code_to_type :: Text -> Maybe Type
code_to_type Text
s = case Text
s of
    Text
"c" -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
Chromatic
    Text
"d" -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
Diatonic
    Text
"nn" -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
Nn
    Text
"t" -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
Score
    Text
"s" -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
Real
    Text
"" -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
Untyped
    Text
_ -> Maybe Type
forall a. Maybe a
Nothing

instance Semigroup Type where
    Type
Untyped <> :: Type -> Type -> Type
<> Type
typed = Type
typed
    Type
typed <> Type
_ = Type
typed
instance Monoid Type where
    mempty :: Type
mempty = Type
Untyped
    mappend :: Type -> Type -> Type
mappend = Type -> Type -> Type
forall a. Semigroup a => a -> a -> a
(<>)

data Typed a = Typed {
    forall a. Typed a -> Type
type_of :: !Type
    , forall a. Typed a -> a
typed_val :: !a
    } deriving (Typed a -> Typed a -> Bool
(Typed a -> Typed a -> Bool)
-> (Typed a -> Typed a -> Bool) -> Eq (Typed a)
forall a. Eq a => Typed a -> Typed a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Typed a -> Typed a -> Bool
$c/= :: forall a. Eq a => Typed a -> Typed a -> Bool
== :: Typed a -> Typed a -> Bool
$c== :: forall a. Eq a => Typed a -> Typed a -> Bool
Eq, Eq (Typed a)
Eq (Typed a)
-> (Typed a -> Typed a -> Ordering)
-> (Typed a -> Typed a -> Bool)
-> (Typed a -> Typed a -> Bool)
-> (Typed a -> Typed a -> Bool)
-> (Typed a -> Typed a -> Bool)
-> (Typed a -> Typed a -> Typed a)
-> (Typed a -> Typed a -> Typed a)
-> Ord (Typed a)
Typed a -> Typed a -> Bool
Typed a -> Typed a -> Ordering
Typed a -> Typed a -> Typed a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Typed a)
forall a. Ord a => Typed a -> Typed a -> Bool
forall a. Ord a => Typed a -> Typed a -> Ordering
forall a. Ord a => Typed a -> Typed a -> Typed a
min :: Typed a -> Typed a -> Typed a
$cmin :: forall a. Ord a => Typed a -> Typed a -> Typed a
max :: Typed a -> Typed a -> Typed a
$cmax :: forall a. Ord a => Typed a -> Typed a -> Typed a
>= :: Typed a -> Typed a -> Bool
$c>= :: forall a. Ord a => Typed a -> Typed a -> Bool
> :: Typed a -> Typed a -> Bool
$c> :: forall a. Ord a => Typed a -> Typed a -> Bool
<= :: Typed a -> Typed a -> Bool
$c<= :: forall a. Ord a => Typed a -> Typed a -> Bool
< :: Typed a -> Typed a -> Bool
$c< :: forall a. Ord a => Typed a -> Typed a -> Bool
compare :: Typed a -> Typed a -> Ordering
$ccompare :: forall a. Ord a => Typed a -> Typed a -> Ordering
Ord, ReadPrec [Typed a]
ReadPrec (Typed a)
Int -> ReadS (Typed a)
ReadS [Typed a]
(Int -> ReadS (Typed a))
-> ReadS [Typed a]
-> ReadPrec (Typed a)
-> ReadPrec [Typed a]
-> Read (Typed a)
forall a. Read a => ReadPrec [Typed a]
forall a. Read a => ReadPrec (Typed a)
forall a. Read a => Int -> ReadS (Typed a)
forall a. Read a => ReadS [Typed a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Typed a]
$creadListPrec :: forall a. Read a => ReadPrec [Typed a]
readPrec :: ReadPrec (Typed a)
$creadPrec :: forall a. Read a => ReadPrec (Typed a)
readList :: ReadS [Typed a]
$creadList :: forall a. Read a => ReadS [Typed a]
readsPrec :: Int -> ReadS (Typed a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Typed a)
Read, Int -> Typed a -> ShowS
[Typed a] -> ShowS
Typed a -> String
(Int -> Typed a -> ShowS)
-> (Typed a -> String) -> ([Typed a] -> ShowS) -> Show (Typed a)
forall a. Show a => Int -> Typed a -> ShowS
forall a. Show a => [Typed a] -> ShowS
forall a. Show a => Typed a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Typed a] -> ShowS
$cshowList :: forall a. Show a => [Typed a] -> ShowS
show :: Typed a -> String
$cshow :: forall a. Show a => Typed a -> String
showsPrec :: Int -> Typed a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Typed a -> ShowS
Show)

instance DeepSeq.NFData a => DeepSeq.NFData (Typed a) where
    rnf :: Typed a -> ()
rnf (Typed Type
typ a
val) = Type
typ Type -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
DeepSeq.rnf a
val

instance Functor Typed where
    fmap :: forall a b. (a -> b) -> Typed a -> Typed b
fmap a -> b
f (Typed Type
typ a
val) = Type -> b -> Typed b
forall a. Type -> a -> Typed a
Typed Type
typ (a -> b
f a
val)

instance Semigroup a => Semigroup (Typed a) where
    Typed Type
t1 a
v1 <> :: Typed a -> Typed a -> Typed a
<> Typed Type
t2 a
v2 = Type -> a -> Typed a
forall a. Type -> a -> Typed a
Typed (Type
t1Type -> Type -> Type
forall a. Semigroup a => a -> a -> a
<>Type
t2) (a
v1a -> a -> a
forall a. Semigroup a => a -> a -> a
<>a
v2)
instance (Semigroup a, Monoid a) => Monoid (Typed a) where
    mempty :: Typed a
mempty = Type -> a -> Typed a
forall a. Type -> a -> Typed a
Typed Type
forall a. Monoid a => a
mempty a
forall a. Monoid a => a
mempty
    mappend :: Typed a -> Typed a -> Typed a
mappend = Typed a -> Typed a -> Typed a
forall a. Semigroup a => a -> a -> a
(<>)

instance Pretty a => Pretty (Typed a) where
    format :: Typed a -> Doc
format (Typed Type
typ a
val) =
        Text -> Doc
Pretty.text (if Text -> Bool
Text.null Text
c then Text
"" else Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":") Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> a -> Doc
forall a. Pretty a => a -> Doc
Pretty.format a
val
        where c :: Text
c = Type -> Text
type_to_code Type
typ

instance ShowVal.ShowVal (Typed Control) where
    show_val :: Typed Control -> Text
show_val (Typed Type
typ Control
c) = Control -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Control
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
type_to_code Type
typ

instance Serialize.Serialize a => Serialize.Serialize (Typed a) where
    put :: Putter (Typed a)
put (Typed Type
a a
b) = Putter Type
forall a. Serialize a => Putter a
Serialize.put Type
a PutM () -> PutM () -> PutM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter a
forall a. Serialize a => Putter a
Serialize.put a
b
    get :: Get (Typed a)
get = Type -> a -> Typed a
forall a. Type -> a -> Typed a
Typed (Type -> a -> Typed a) -> Get Type -> Get (a -> Typed a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Type
forall a. Serialize a => Get a
Serialize.get Get (a -> Typed a) -> Get a -> Get (Typed a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
forall a. Serialize a => Get a
Serialize.get

merge_typed :: (a -> a -> a) -> Typed a -> Typed a -> Typed a
merge_typed :: forall a. (a -> a -> a) -> Typed a -> Typed a -> Typed a
merge_typed a -> a -> a
f (Typed Type
typ1 a
v1) (Typed Type
typ2 a
v2) = Type -> a -> Typed a
forall a. Type -> a -> Typed a
Typed (Type
typ1Type -> Type -> Type
forall a. Semigroup a => a -> a -> a
<>Type
typ2) (a -> a -> a
f a
v1 a
v2)

untyped :: a -> Typed a
untyped :: forall a. a -> Typed a
untyped = Type -> a -> Typed a
forall a. Type -> a -> Typed a
Typed Type
Untyped

type_to_transpose :: Typed Signal.Y -> Maybe Pitch.Transpose
type_to_transpose :: Typed Y -> Maybe Transpose
type_to_transpose (Typed Type
typ Y
val) = case Type
typ of
    Type
Diatonic -> Transpose -> Maybe Transpose
forall a. a -> Maybe a
Just (Transpose -> Maybe Transpose) -> Transpose -> Maybe Transpose
forall a b. (a -> b) -> a -> b
$ Y -> Transpose
Pitch.Diatonic Y
val
    Type
Chromatic -> Transpose -> Maybe Transpose
forall a. a -> Maybe a
Just (Transpose -> Maybe Transpose) -> Transpose -> Maybe Transpose
forall a b. (a -> b) -> a -> b
$ Y -> Transpose
Pitch.Chromatic Y
val
    Type
Nn -> Transpose -> Maybe Transpose
forall a. a -> Maybe a
Just (Transpose -> Maybe Transpose) -> Transpose -> Maybe Transpose
forall a b. (a -> b) -> a -> b
$ Y -> Transpose
Pitch.Nn Y
val
    Type
_ -> Maybe Transpose
forall a. Maybe a
Nothing

-- * ControlMap

instance ShowVal.ShowVal (Typed Signal.Y) where
    show_val :: Typed Y -> Text
show_val (Typed Type
typ Y
val) = Y -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Y
val Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
type_to_code Type
typ

-- | This is a snapshot of the control signals at a certain point in time.
-- It's meant for 'Derive.PSignal.PitchConfig', so the values are expected to
-- be transpositions, and hence untyped.
type ControlValMap = Map Control Signal.Y
type TypedControlValMap = Map Control (Typed Signal.Y)