-- Copyright 2013 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

{- | Utilities for calls.

    The convention for calls is that there is a function @c_something@ which
    is type NoteCall or ControlCall or whatever.  It then extracts what is
    needed from the PassedArgs and passes those values to a function
    @something@ which is of type NoteDeriver or ControlDeriver or whatever.
    The idea is that PassedArgs is a large dependency and it should be reduced
    immediately to what is needed.
-}
module Derive.Call where
import qualified Data.List as List
import qualified Data.Set as Set
import qualified System.Random.Mersenne.Pure64 as Pure64

import qualified Util.Num as Num
import qualified Util.Random as Random
import qualified Cmd.TimeStep as TimeStep
import qualified Derive.Args as Args
import qualified Derive.Attrs as Attrs
import qualified Derive.Controls as Controls
import qualified Derive.Derive as Derive
import qualified Derive.DeriveT as DeriveT
import qualified Derive.Deriver.Internal as Internal
import qualified Derive.EnvKey as EnvKey
import qualified Derive.Eval as Eval
import qualified Derive.Expr as Expr
import qualified Derive.Flags as Flags
import qualified Derive.PSignal as PSignal
import qualified Derive.Pitches as Pitches
import qualified Derive.Scale as Scale
import qualified Derive.Score as Score
import qualified Derive.ScoreT as ScoreT
import qualified Derive.ShowVal as ShowVal
import qualified Derive.Symbols as Symbols
import qualified Derive.Typecheck as Typecheck

import qualified Perform.Pitch as Pitch
import qualified Perform.RealTime as RealTime
import qualified Perform.Signal as Signal

import qualified Ui.Meter.Meter as Meter
import qualified Ui.ScoreTime as ScoreTime

import           Global
import           Types


-- * dynamic

-- | Unlike 'Derive.pitch_at', the transposition has already been applied.
transposed :: RealTime -> Derive.Deriver (Maybe PSignal.Transposed)
transposed :: RealTime -> Deriver (Maybe Transposed)
transposed RealTime
pos =
    forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> (a -> m (Maybe b)) -> m (Maybe b)
justm (RealTime -> Deriver (Maybe Pitch)
Derive.pitch_at RealTime
pos) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealTime -> Pitch -> Deriver Transposed
Derive.resolve_pitch RealTime
pos

get_transposed :: RealTime -> Derive.Deriver PSignal.Transposed
get_transposed :: RealTime -> Deriver Transposed
get_transposed RealTime
pos = forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require (Text
"no pitch at " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty RealTime
pos)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RealTime -> Deriver (Maybe Transposed)
transposed RealTime
pos

-- | Pitch without the transposition applied.  You have to use this if you
-- create an event with a pitch based on this pitch, otherwise the
-- transposition will be applied twice.
get_pitch :: RealTime -> Derive.Deriver PSignal.Pitch
get_pitch :: RealTime -> Deriver Pitch
get_pitch RealTime
pos = forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require (Text
"no pitch at " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty RealTime
pos)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RealTime -> Deriver (Maybe Pitch)
Derive.pitch_at RealTime
pos

get_pitch_here :: Derive.PassedArgs a -> Derive.Deriver PSignal.Pitch
get_pitch_here :: forall a. PassedArgs a -> Deriver Pitch
get_pitch_here = RealTime -> Deriver Pitch
get_pitch forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. PassedArgs a -> Deriver RealTime
Args.real_start

-- | Get the symbolic version of the transposed pitch.  Since it's transposed,
-- if you turn it back to a 'PSignal.Pitch', you should use
-- 'with_transposed_pitch'.
get_parsed_pitch :: (Pitch.Note -> Maybe Pitch.Pitch)
    -- ^ Parse pitch function, as returned by 'get_pitch_functions'.
    -- It's passed separately to avoid the overhead of calling
    -- get_pitch_functions multiple times.
    -> RealTime -> Derive.Deriver Pitch.Pitch
get_parsed_pitch :: (Note -> Maybe Pitch) -> RealTime -> Deriver Pitch
get_parsed_pitch Note -> Maybe Pitch
parse = forall a. (Note -> Maybe a) -> Transposed -> Deriver a
parse_pitch Note -> Maybe Pitch
parse forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< RealTime -> Deriver Transposed
get_transposed

get_symbolic_pitch :: RealTime -> Derive.Deriver Pitch.Note
get_symbolic_pitch :: RealTime -> Deriver Note
get_symbolic_pitch = Transposed -> Deriver Note
Pitches.pitch_note forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< RealTime -> Deriver Transposed
get_transposed

dynamic :: RealTime -> Derive.Deriver Signal.Y
dynamic :: RealTime -> Deriver Double
dynamic RealTime
pos = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
Derive.default_dynamic forall a. Typed a -> a
ScoreT.val_of forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Control -> RealTime -> Deriver (Maybe (Typed Double))
Derive.control_at Control
Controls.dynamic RealTime
pos

with_pitch :: PSignal.Pitch -> Derive.Deriver a -> Derive.Deriver a
with_pitch :: forall a. Pitch -> Deriver a -> Deriver a
with_pitch = forall a. Pitch -> Deriver a -> Deriver a
Derive.with_constant_pitch

with_transposed_pitch :: PSignal.Transposed -> Derive.Deriver a
    -> Derive.Deriver a
with_transposed_pitch :: forall a. Transposed -> Deriver a -> Deriver a
with_transposed_pitch Transposed
pitch =
    forall a. Deriver a -> Deriver a
without_transpose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pitch -> Deriver a -> Deriver a
with_pitch (forall a b. RawPitch a -> RawPitch b
PSignal.coerce Transposed
pitch)

without_transpose :: Derive.Deriver a -> Derive.Deriver a
without_transpose :: forall a. Deriver a -> Deriver a
without_transpose = forall a. [Control] -> Deriver a -> Deriver a
Derive.remove_controls (forall a. Set a -> [a]
Set.toList Set Control
Controls.transposers)

with_symbolic_pitch :: DeriveT.PitchCall -> ScoreTime -> Derive.Deriver a
    -> Derive.Deriver a
with_symbolic_pitch :: forall a. PitchCall -> ScoreTime -> Deriver a -> Deriver a
with_symbolic_pitch PitchCall
call ScoreTime
pos Deriver a
deriver = do
    Pitch
pitch <- forall a. ScoreTime -> PitchCall -> Deriver (RawPitch a)
Eval.eval_pitch ScoreTime
pos PitchCall
call
    forall a. Pitch -> Deriver a -> Deriver a
with_pitch Pitch
pitch Deriver a
deriver

-- | Replace the dynamic with the given one.
with_dynamic :: Signal.Y -> Derive.Deriver a -> Derive.Deriver a
with_dynamic :: forall a. Double -> Deriver a -> Deriver a
with_dynamic = forall a. Control -> Double -> Deriver a -> Deriver a
with_constant Control
Controls.dynamic

multiply_dynamic :: Signal.Y -> Derive.Deriver a -> Derive.Deriver a
multiply_dynamic :: forall a. Double -> Deriver a -> Deriver a
multiply_dynamic = forall a. Control -> Double -> Deriver a -> Deriver a
multiply_constant Control
Controls.dynamic

with_constant :: ScoreT.Control -> Signal.Y -> Derive.Deriver a
    -> Derive.Deriver a
with_constant :: forall a. Control -> Double -> Deriver a -> Deriver a
with_constant Control
control = forall a. Control -> Typed Control -> Deriver a -> Deriver a
Derive.with_control Control
control forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Typed a
ScoreT.untyped
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (kind :: k). Double -> Signal kind
Signal.constant

add_control, multiply_control :: ScoreT.Control -> ScoreT.Typed Signal.Control
    -> Derive.Deriver a -> Derive.Deriver a
add_control :: forall a. Control -> Typed Control -> Deriver a -> Deriver a
add_control = forall a.
Merger -> Control -> Typed Control -> Deriver a -> Deriver a
Derive.with_merged_control Merger
Derive.merge_add
multiply_control :: forall a. Control -> Typed Control -> Deriver a -> Deriver a
multiply_control = forall a.
Merger -> Control -> Typed Control -> Deriver a -> Deriver a
Derive.with_merged_control Merger
Derive.merge_mul

add_constant, multiply_constant :: ScoreT.Control -> Signal.Y
    -> Derive.Deriver a -> Derive.Deriver a
multiply_constant :: forall a. Control -> Double -> Deriver a -> Deriver a
multiply_constant Control
control Double
val
    | Double
val forall a. Eq a => a -> a -> Bool
== Double
1 = forall a. a -> a
id
    | Bool
otherwise = forall a.
Merger -> Control -> Typed Control -> Deriver a -> Deriver a
Derive.with_merged_control Merger
Derive.merge_mul Control
control
        (forall a. a -> Typed a
ScoreT.untyped (forall {k} (kind :: k). Double -> Signal kind
Signal.constant Double
val))
add_constant :: forall a. Control -> Double -> Deriver a -> Deriver a
add_constant Control
control Double
val
    | Double
val forall a. Eq a => a -> a -> Bool
== Double
0 = forall a. a -> a
id
    | Bool
otherwise = forall a.
Merger -> Control -> Typed Control -> Deriver a -> Deriver a
Derive.with_merged_control Merger
Derive.merge_add Control
control
        (forall a. a -> Typed a
ScoreT.untyped (forall {k} (kind :: k). Double -> Signal kind
Signal.constant Double
val))

-- * environ

get_srate :: Derive.Deriver RealTime
get_srate :: Deriver RealTime
get_srate = Double -> RealTime
RealTime.seconds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Typecheck a => Text -> Deriver a
Derive.get_val Text
EnvKey.srate

get_scale :: Derive.Deriver Scale.Scale
get_scale :: Deriver Scale
get_scale = ScaleId -> Deriver Scale
Derive.get_scale forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Deriver ScaleId
get_scale_id

lookup_scale :: Derive.Deriver (Maybe Scale.Scale)
lookup_scale :: Deriver (Maybe Scale)
lookup_scale = ScaleId -> Deriver (Maybe Scale)
Derive.lookup_scale forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Deriver ScaleId
get_scale_id

get_scale_id :: Derive.Deriver Pitch.ScaleId
get_scale_id :: Deriver ScaleId
get_scale_id = Str -> ScaleId
Expr.str_to_scale_id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Typecheck a => Text -> Deriver a
Derive.get_val Text
EnvKey.scale

lookup_key :: Derive.Deriver (Maybe Pitch.Key)
lookup_key :: Deriver (Maybe Key)
lookup_key = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Key
Pitch.Key forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Typecheck a => Text -> Deriver (Maybe a)
Derive.lookup_val Text
EnvKey.key

get_instrument :: Derive.Deriver ScoreT.Instrument
get_instrument :: Deriver Instrument
get_instrument = forall a. Typecheck a => Text -> Deriver a
Derive.get_val Text
EnvKey.instrument

lookup_instrument :: Derive.Deriver (Maybe ScoreT.Instrument)
lookup_instrument :: Deriver (Maybe Instrument)
lookup_instrument = forall a. Typecheck a => Text -> Deriver (Maybe a)
Derive.lookup_val Text
EnvKey.instrument

get_attributes :: Derive.Deriver Attrs.Attributes
get_attributes :: Deriver Attributes
get_attributes = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Typecheck a => Text -> Deriver (Maybe a)
Derive.lookup_val Text
EnvKey.attributes

-- * parsing pitches

-- | Get symbolic pitch manipulating functions for the current scale.  This
-- is for calls that want to work with symbolic pitches.
get_pitch_functions :: Derive.Deriver
    ( Pitch.Note -> Maybe Pitch.Pitch
    , Pitch.Pitch -> Maybe Pitch.Note
    , Scale.Transposition -> Pitch.Step -> Pitch.Pitch -> Maybe Pitch.Pitch
    )
get_pitch_functions :: Deriver
  (Note -> Maybe Pitch, Pitch -> Maybe Note,
   Transposition -> Int -> Pitch -> Maybe Pitch)
get_pitch_functions = do
    Scale
scale <- Deriver Scale
get_scale
    Environ
env <- Deriver Environ
Derive.get_environ
    let transpose :: Transposition -> Int -> Pitch -> Maybe Pitch
transpose Transposition
transposition Int
steps =
            forall {a} {a}. Either a a -> Maybe a
to_maybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scale -> Transpose
Scale.scale_transpose Scale
scale Transposition
transposition Environ
env Int
steps
    forall (m :: * -> *) a. Monad m => a -> m a
return
        ( forall {a} {a}. Either a a -> Maybe a
to_maybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scale -> Environ -> Note -> Either PitchError Pitch
Scale.scale_read Scale
scale Environ
env
        , forall {a} {a}. Either a a -> Maybe a
to_maybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scale -> Environ -> Pitch -> Either PitchError Note
Scale.scale_show Scale
scale Environ
env
        , Transposition -> Int -> Pitch -> Maybe Pitch
transpose
        )
    where to_maybe :: Either a a -> Maybe a
to_maybe = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just

parse_pitch :: (Pitch.Note -> Maybe a) -> PSignal.Transposed
    -> Derive.Deriver a
parse_pitch :: forall a. (Note -> Maybe a) -> Transposed -> Deriver a
parse_pitch Note -> Maybe a
parse Transposed
pitch = do
    Note
note <- Transposed -> Deriver Note
Pitches.pitch_note Transposed
pitch
    forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require Text
"unparseable pitch" forall a b. (a -> b) -> a -> b
$ Note -> Maybe a
parse Note
note

nn_difference :: RealTime -> PSignal.Pitch -> PSignal.Pitch
    -> Derive.Deriver Pitch.NoteNumber
nn_difference :: RealTime -> Pitch -> Pitch -> Deriver NoteNumber
nn_difference RealTime
pos Pitch
pitch1 Pitch
pitch2 = do
    Transposed
pitch1 <- RealTime -> Pitch -> Deriver Transposed
Derive.resolve_pitch RealTime
pos Pitch
pitch1
    Transposed
pitch2 <- RealTime -> Pitch -> Deriver Transposed
Derive.resolve_pitch RealTime
pos Pitch
pitch2
    (-) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Transposed -> Deriver NoteNumber
Pitches.pitch_nn Transposed
pitch1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Transposed -> Deriver NoteNumber
Pitches.pitch_nn Transposed
pitch2

-- * note

eval_pitch_ :: ScoreTime -> Pitch.Pitch -> Derive.Deriver PSignal.Transposed
eval_pitch_ :: ScoreTime -> Pitch -> Deriver Transposed
eval_pitch_ ScoreTime
start Pitch
pitch = do
    (Note -> Maybe Pitch
_, Pitch -> Maybe Note
show_pitch, Transposition -> Int -> Pitch -> Maybe Pitch
_) <- Deriver
  (Note -> Maybe Pitch, Pitch -> Maybe Note,
   Transposition -> Int -> Pitch -> Maybe Pitch)
get_pitch_functions
    (Pitch -> Maybe Note) -> ScoreTime -> Pitch -> Deriver Transposed
eval_pitch Pitch -> Maybe Note
show_pitch ScoreTime
start Pitch
pitch

-- | Evaluate a 'Pitch.Pitch'.  It returns a transposed pitch since
-- a 'Pitch.Pitch' is assumed to have been transposed (e.g. 'get_parsed_pitch'
-- uses a transposed pitch so range calculation works).
eval_pitch :: (Pitch.Pitch -> Maybe Pitch.Note) -> ScoreTime -> Pitch.Pitch
    -> Derive.Deriver PSignal.Transposed
eval_pitch :: (Pitch -> Maybe Note) -> ScoreTime -> Pitch -> Deriver Transposed
eval_pitch Pitch -> Maybe Note
show_pitch ScoreTime
start Pitch
pitch = do
    Note
note <- forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require (Text
"scale doesn't have pitch: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Pitch
pitch)
        (Pitch -> Maybe Note
show_pitch Pitch
pitch)
    ScoreTime -> Note -> Deriver Transposed
eval_note ScoreTime
start Note
note

-- | Evaluate a symbolic pitch.  Like 'eval_pitch', I assume the Note was
-- Transposed, or at least should be an absolute pitch.
eval_note :: ScoreTime -> Pitch.Note -> Derive.Deriver PSignal.Transposed
eval_note :: ScoreTime -> Note -> Deriver Transposed
eval_note ScoreTime
pos Note
note = forall a. ScoreTime -> PitchCall -> Deriver (RawPitch a)
Eval.eval_pitch ScoreTime
pos forall a b. (a -> b) -> a -> b
$
    forall val. Symbol -> Call val
Expr.call0 (Text -> Symbol
Expr.Symbol (Note -> Text
Pitch.note_text Note
note))

-- | Generate a single note, from 0 to 1.
note :: Derive.NoteDeriver
note :: NoteDeriver
note = forall d. CallableExpr d => Bool -> PitchCall -> Deriver (Stream d)
Eval.eval_one_call Bool
True forall a b. (a -> b) -> a -> b
$ forall val. Symbol -> Call val
Expr.call0 Symbol
Symbols.null_note

-- | Like 'note', but the note reuses the Context, which means it will inherit
-- the caller's start and duration as well as sub-tracks and thus may apply
-- inversion.
--
-- This is appropriate when adding a wrapper around the default note call, but
-- not if you don't want to be overridden by sub-tracks.  See 'placed_note'
-- if you want to inherit the time, but not the rest.
reapply_note :: Derive.NoteArgs -> Derive.NoteDeriver
reapply_note :: NoteArgs -> NoteDeriver
reapply_note NoteArgs
args = forall d.
CallableExpr d =>
Context d -> Symbol -> [Term] -> Deriver (Stream d)
Eval.reapply_call (forall a. PassedArgs a -> Context a
Args.context NoteArgs
args) Symbol
Symbols.null_note []

-- | Override the pitch signal and generate a single note.
pitched_note :: PSignal.Pitch -> Derive.NoteDeriver
pitched_note :: Pitch -> NoteDeriver
pitched_note Pitch
pitch = forall a. Pitch -> Deriver a -> Deriver a
with_pitch Pitch
pitch NoteDeriver
note

transposed_pitched_note :: PSignal.Transposed -> Derive.NoteDeriver
transposed_pitched_note :: Transposed -> NoteDeriver
transposed_pitched_note Transposed
pitch = forall a. Transposed -> Deriver a -> Deriver a
with_transposed_pitch Transposed
pitch NoteDeriver
note

-- | Add an attribute and generate a single note.
attribute_note :: Attrs.Attributes -> Derive.NoteDeriver
attribute_note :: Attributes -> NoteDeriver
attribute_note Attributes
attrs = forall d. Attributes -> Deriver d -> Deriver d
add_attributes Attributes
attrs NoteDeriver
note

-- | A zero-duration 'note'.
triggered_note :: Derive.NoteDeriver
triggered_note :: NoteDeriver
triggered_note =
    forall d.
CallableExpr d =>
Bool -> ScoreTime -> ScoreTime -> Expr -> Deriver (Stream d)
Eval.eval_one_at Bool
True ScoreTime
0 ScoreTime
0 forall a b. (a -> b) -> a -> b
$ forall val. Symbol -> Expr val
Expr.generator0 Symbol
Symbols.null_note

place :: Derive.PassedArgs d -> Derive.Deriver a -> Derive.Deriver a
place :: forall d a. PassedArgs d -> Deriver a -> Deriver a
place = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. ScoreTime -> ScoreTime -> Deriver a -> Deriver a
Derive.place forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PassedArgs a -> (ScoreTime, ScoreTime)
Args.extent

placed_note :: Derive.PassedArgs d -> Derive.NoteDeriver
placed_note :: forall d. PassedArgs d -> NoteDeriver
placed_note PassedArgs d
args = forall d a. PassedArgs d -> Deriver a -> Deriver a
place PassedArgs d
args NoteDeriver
note

-- * transformer notes

-- | Derive with transformed Attributes.
with_attributes :: (Attrs.Attributes -> Attrs.Attributes) -> Derive.Deriver d
    -> Derive.Deriver d
with_attributes :: forall d. (Attributes -> Attributes) -> Deriver d -> Deriver d
with_attributes Attributes -> Attributes
f Deriver d
deriver = do
    Attributes
attrs <- Deriver Attributes
get_attributes
    forall val a. ToVal val => Text -> val -> Deriver a -> Deriver a
Derive.with_val Text
EnvKey.attributes (Attributes -> Attributes
f Attributes
attrs) Deriver d
deriver

add_attributes :: Attrs.Attributes -> Derive.Deriver d -> Derive.Deriver d
add_attributes :: forall d. Attributes -> Deriver d -> Deriver d
add_attributes Attributes
attrs
    | Attributes
attrs forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty = forall a. a -> a
id
    | Bool
otherwise = forall d. (Attributes -> Attributes) -> Deriver d -> Deriver d
with_attributes (forall a. Semigroup a => a -> a -> a
<> Attributes
attrs)

add_flags :: Flags.Flags -> Derive.NoteDeriver -> Derive.NoteDeriver
add_flags :: Flags -> NoteDeriver -> NoteDeriver
add_flags Flags
flags
    | Flags
flags forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty = forall a. a -> a
id
    | Bool
otherwise = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Flags -> Event -> Event
Score.add_flags Flags
flags))

-- * random

-- | Get an infinite list of random numbers.  These are deterministic in that
-- they depend only on the random seed, but the random seed is hashed with
-- each stack entry.  So if you fix the random seed at a certain point, you
-- should get consistent results below it.
--
-- It's a class because both Doubles and Ints are useful and I'd like to use
-- the same function name for both.
class Random a where
    -- | Infinite list of random numbers.  These are deterministic in that
    -- they depend on the current track, current call position, and the random
    -- seed.
    randoms :: Derive.Deriver [a]
    -- | Infinite list of random numbers in the given range.
    randoms_in :: a -> a -> Derive.Deriver [a]

instance Random Double where
    -- | Random numbers in the range [0, 1).
    randoms :: Deriver [Double]
randoms = forall a. (PureMT -> (a, PureMT)) -> Deriver [a]
_make_randoms PureMT -> (Double, PureMT)
Pure64.randomDouble
        -- Pure64.randomDouble doesn't document the range, but that's what it
        -- is.
    randoms_in :: Double -> Double -> Deriver [Double]
randoms_in Double
low Double
high = forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Eq a, Num a) => a -> a -> a -> a
Num.scale Double
low Double
high) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => Deriver [a]
randoms

instance Random Int where
    -- Random numbers between INT_MIN and INT_MAX.
    randoms :: Deriver [Int]
randoms = forall a. (PureMT -> (a, PureMT)) -> Deriver [a]
_make_randoms PureMT -> (Int, PureMT)
Pure64.randomInt
    randoms_in :: Int -> Int -> Deriver [Int]
randoms_in Int
low Int
high = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Real a => a -> a -> a -> a
Num.restrict Int
low Int
high) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => Deriver [a]
randoms

-- | Get a random Double or Int.  Ints will lose precision if converted to
-- double!
random :: Random a => Derive.Deriver a
random :: forall a. Random a => Deriver a
random = forall a. [a] -> a
head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => Deriver [a]
randoms

random_in :: (Random a, Real a) => a -> a -> Derive.Deriver a
random_in :: forall a. (Random a, Real a) => a -> a -> Deriver a
random_in a
low a
high
    | a
low forall a. Eq a => a -> a -> Bool
== a
high = forall (m :: * -> *) a. Monad m => a -> m a
return a
low
    | Bool
otherwise = forall a. [a] -> a
head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => a -> a -> Deriver [a]
randoms_in a
low a
high

-- | If the chance is 1, return true all the time, if it's 0.5, return it half
-- of the time.
chance :: Double -> Derive.Deriver Bool
chance :: Double -> Deriver Bool
chance Double
v
    | Double
v forall a. Ord a => a -> a -> Bool
>= Double
1 = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    | Double
v forall a. Ord a => a -> a -> Bool
<= Double
0 = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    | Bool
otherwise = do
        Double
r <- forall a. (Random a, Real a) => a -> a -> Deriver a
random_in Double
0 Double
1
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Double
r forall a. Ord a => a -> a -> Bool
<= Double
v

shuffle :: [a] -> Derive.Deriver [a]
shuffle :: forall a. [a] -> Deriver [a]
shuffle [a]
xs = forall a. [a] -> [Int] -> [a]
Random.shuffle [a]
xs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => Deriver [a]
randoms

_make_randoms :: (Pure64.PureMT -> (a, Pure64.PureMT)) -> Derive.Deriver [a]
_make_randoms :: forall a. (PureMT -> (a, PureMT)) -> Deriver [a]
_make_randoms PureMT -> (a, PureMT)
f = forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. PureMT -> (a, PureMT)
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Deriver PureMT
_random_generator

_random_generator :: Derive.Deriver Pure64.PureMT
_random_generator :: Deriver PureMT
_random_generator = do
    Double
seed <- forall a. a -> Maybe a -> a
fromMaybe Double
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Typecheck a => Text -> Deriver (Maybe a)
Derive.lookup_val Text
EnvKey.seed
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word64 -> PureMT
Pure64.pureMT (forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
seed :: Double))

pick_weighted :: NonEmpty (Double, a) -> Double -> a
pick_weighted :: forall a. NonEmpty (Double, a) -> Double -> a
pick_weighted NonEmpty (Double, a)
weights Double
rnd_ = forall {b}. Double -> NonEmpty (Double, b) -> b
go Double
0 NonEmpty (Double, a)
weights
    where
    rnd :: Double
rnd = Double
rnd_ forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst NonEmpty (Double, a)
weights)
    go :: Double -> NonEmpty (Double, b) -> b
go Double
collect ((Double
weight, b
a) :| [(Double, b)]
weights) = case [(Double, b)]
weights of
        [] -> b
a
        (Double, b)
w : [(Double, b)]
ws
            | Double
collect forall a. Num a => a -> a -> a
+ Double
weight forall a. Ord a => a -> a -> Bool
> Double
rnd -> b
a
            | Bool
otherwise -> Double -> NonEmpty (Double, b) -> b
go (Double
collect forall a. Num a => a -> a -> a
+ Double
weight) ((Double, b)
w forall a. a -> [a] -> NonEmpty a
:| [(Double, b)]
ws)

-- | Like 'pick_weighted' when all the weights are equal.
pick :: NonEmpty a -> Double -> a
pick :: forall a. NonEmpty a -> Double -> a
pick (a
x :| [a]
xs) Double
rnd = (a
xforall a. a -> [a] -> [a]
:[a]
xs) forall a. [a] -> Int -> a
!! Int
i
    where i :: Int
i = forall a b. (RealFrac a, Integral b) => a -> b
round (Double
rnd forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs))

-- TODO what I want is a bounded normal distribution.
-- Unfortunately it seems to be really complicated to actually sample that.
-- I could use anything with a similar shape actually.
normal :: Double -> Derive.Deriver Double
normal :: Double -> Deriver Double
normal Double
stddev = Double -> [Double] -> Double
make_normal Double
stddev forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => Deriver [a]
randoms
{- notes:
    . Approximate normal distribution: sum (take n randoms) / n
    . normalCumulative mean stddev x =
          SpecFunctions.erfc ((mean - x) / ndCdfDenom) / 2
          where
          ndCdfDenom = Constants.m_sqrt_2 * stddev
    . Make a with_variation, so the choice is in the call, not the patch.
    . I want to give center and width, and then pick according to that
      distribution.  Alternately, if I can map a uniform 0-1.
    . Truncated normal distribution seems best, and I can map a uniformly
      distributed value through its cumulative probability function.
    . This is called "inverse transform sampling".  It's possible for
      truncated normal, but complicated:
      https://www.christophlassner.de/blog/2013/08/12/Generation-of-Truncated-Gaussian-Samples/
    . Rejection sampling just means I do a 2d normal distribution until
      I get something under the PDF.  Theoretically unbound time.
    . I don't care about the exact statistical properties, just that it
      has a similar shape.
-}

-- | Approximation to a normal distribution between 0 and 1, inclusive.
-- I can't use an actual normal distribution because I need it to be bounded.
make_normal :: Double -> [Double] -> Double
make_normal :: Double -> [Double] -> Double
make_normal Double
stddev [Double]
rnds = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum (forall a. Int -> [a] -> [a]
take Int
samples [Double]
rnds) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
samples
    where
    samples :: Int
samples = Int
12

-- * conditional

if_env :: (Eq val, Typecheck.Typecheck val) => EnvKey.Key -> Maybe val
    -> Derive.Deriver a -> Derive.Deriver a -> Derive.Deriver a
if_env :: forall val a.
(Eq val, Typecheck val) =>
Text -> Maybe val -> Deriver a -> Deriver a -> Deriver a
if_env Text
key Maybe val
val Deriver a
is_set Deriver a
not_set =
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM ((forall a. Eq a => a -> a -> Bool
==Maybe val
val) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Typecheck a => Text -> Deriver (Maybe a)
Derive.lookup_val Text
key) Deriver a
is_set Deriver a
not_set

when_env :: (Eq val, Typecheck.Typecheck val) => EnvKey.Key -> Maybe val
    -> (Derive.Deriver a -> Derive.Deriver a)
    -> Derive.Deriver a -> Derive.Deriver a
when_env :: forall val a.
(Eq val, Typecheck val) =>
Text
-> Maybe val -> (Deriver a -> Deriver a) -> Deriver a -> Deriver a
when_env Text
key Maybe val
val Deriver a -> Deriver a
transformer Deriver a
deriver =
    forall val a.
(Eq val, Typecheck val) =>
Text -> Maybe val -> Deriver a -> Deriver a -> Deriver a
if_env Text
key Maybe val
val (Deriver a -> Deriver a
transformer Deriver a
deriver) Deriver a
deriver

-- * time

-- | Get the real duration of time val at the given point in time.  RealTime is
-- linear, so 1 second is always 1 second no matter where it is, but ScoreTime
-- will map to different amounts of RealTime depending on where it is.
real_duration :: (Derive.Time t1, Derive.Time t2) => t1 -> t2
    -> Derive.Deriver RealTime
real_duration :: forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver RealTime
real_duration t1
start t2
dur = case forall a. Time a => a -> Duration
Derive.to_duration t2
dur of
    DeriveT.RealDuration RealTime
t -> forall (m :: * -> *) a. Monad m => a -> m a
return RealTime
t
    DeriveT.ScoreDuration ScoreTime
t
        | ScoreTime
t forall a. Eq a => a -> a -> Bool
== ScoreTime
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return RealTime
0
        | Bool
otherwise -> do
            -- I'm adding score to real, so I want the amount of real time in
            -- the future I am if I advance the given amount of score time from
            -- 'start'.
            ScoreTime
score_start <- forall a. Time a => a -> Deriver ScoreTime
Derive.score t1
start
            RealTime
real_start <- forall a. Time a => a -> Deriver RealTime
Derive.real t1
start
            RealTime
end <- forall a. Time a => a -> Deriver RealTime
Derive.real forall a b. (a -> b) -> a -> b
$ ScoreTime
score_start forall a. Num a => a -> a -> a
+ ScoreTime
t
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ RealTime
end forall a. Num a => a -> a -> a
- RealTime
real_start

-- | Like 'real_duration', but get the duration in ScoreTime.  If you are
-- manipulating deriver abstractly instead of directly emitting events then you
-- will place them via 'Derive.at' and family, which are in ScoreTime.
score_duration :: (Derive.Time t1, Derive.Time t2) => t1 -> t2
    -> Derive.Deriver ScoreTime
score_duration :: forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver ScoreTime
score_duration t1
start t2
dur = case forall a. Time a => a -> Duration
Derive.to_duration t2
dur of
    DeriveT.ScoreDuration ScoreTime
t -> forall (m :: * -> *) a. Monad m => a -> m a
return ScoreTime
t
    DeriveT.RealDuration RealTime
t
        | RealTime
t forall a. Eq a => a -> a -> Bool
== RealTime
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return ScoreTime
0
        | Bool
otherwise -> do
            -- I'm adding real to score, so I want the amount of amount of
            -- score time I'd have to advance in order for the given amount
            -- of real time to pass.
            ScoreTime
score_start <- forall a. Time a => a -> Deriver ScoreTime
Derive.score t1
start
            RealTime
real_start <- forall a. Time a => a -> Deriver RealTime
Derive.real t1
start
            ScoreTime
end <- forall a. Time a => a -> Deriver ScoreTime
Derive.score forall a b. (a -> b) -> a -> b
$ RealTime
real_start forall a. Num a => a -> a -> a
+ RealTime
t
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ScoreTime
end forall a. Num a => a -> a -> a
- ScoreTime
score_start

-- | A time range from the event start until a given duration.
duration_from_start :: Derive.Time t => Derive.PassedArgs d -> t
    -> Derive.Deriver (RealTime, RealTime) -- ^ (start, start+dur)
duration_from_start :: forall t d.
Time t =>
PassedArgs d -> t -> Deriver (RealTime, RealTime)
duration_from_start PassedArgs d
args t
t = do
    RealTime
start <- forall a. PassedArgs a -> Deriver RealTime
Args.real_start PassedArgs d
args
    RealTime
dur <- forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver RealTime
real_duration RealTime
start t
t
    forall (m :: * -> *) a. Monad m => a -> m a
return (RealTime
start, RealTime
start forall a. Num a => a -> a -> a
+ RealTime
dur)

-- | Like 'duration_from_start', but subtract a duration from the end.
duration_from_end :: Derive.Time t => Derive.PassedArgs d -> t
    -> Derive.Deriver (RealTime, RealTime) -- ^ (end-dur, end)
duration_from_end :: forall t d.
Time t =>
PassedArgs d -> t -> Deriver (RealTime, RealTime)
duration_from_end PassedArgs d
args t
t = do
    RealTime
end <- forall a. PassedArgs a -> Deriver RealTime
Args.real_end PassedArgs d
args
    RealTime
dur <- forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver RealTime
real_duration RealTime
end t
t
    forall (m :: * -> *) a. Monad m => a -> m a
return (RealTime
end forall a. Num a => a -> a -> a
- RealTime
dur, RealTime
end)

-- | This is 'real_duration', but takes a ScoreT.Typed Signal.Y.
typed_real_duration :: Derive.Time t => ScoreT.TimeT -> t
    -> ScoreT.Typed Signal.Y -> Derive.Deriver RealTime
typed_real_duration :: forall t. Time t => TimeT -> t -> Typed Double -> Deriver RealTime
typed_real_duration TimeT
default_type t
from (ScoreT.Typed Type
typ Double
val)
    | Type
typ forall a. Eq a => a -> a -> Bool
== Type
ScoreT.Real
        Bool -> Bool -> Bool
|| Type
typ forall a. Eq a => a -> a -> Bool
== Type
ScoreT.Untyped Bool -> Bool -> Bool
&& TimeT
default_type forall a. Eq a => a -> a -> Bool
== TimeT
ScoreT.TReal =
            forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> RealTime
RealTime.seconds Double
val)
    | Type
typ forall a. Eq a => a -> a -> Bool
== Type
ScoreT.Score
        Bool -> Bool -> Bool
|| Type
typ forall a. Eq a => a -> a -> Bool
== Type
ScoreT.Untyped Bool -> Bool -> Bool
&& TimeT
default_type forall a. Eq a => a -> a -> Bool
== TimeT
ScoreT.TScore =
            forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver RealTime
real_duration t
from (Double -> ScoreTime
ScoreTime.from_double Double
val)
    | Bool
otherwise = forall a. HasCallStack => Text -> Deriver a
Derive.throw forall a b. (a -> b) -> a -> b
$
        Text
"expected time type for " forall a. Semigroup a => a -> a -> a
<> forall a. ShowVal a => a -> Text
ShowVal.show_val (forall a. Type -> a -> Typed a
ScoreT.Typed Type
typ Double
val)

real_duration_at :: ScoreT.TypedFunction -> RealTime
    -> Derive.Deriver RealTime
real_duration_at :: TypedFunction -> RealTime -> Deriver RealTime
real_duration_at TypedFunction
f RealTime
t = forall t. Time t => TimeT -> t -> Typed Double -> Deriver RealTime
typed_real_duration TimeT
ScoreT.TReal RealTime
t ((forall a b. (a -> b) -> a -> b
$ RealTime
t) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypedFunction
f)

-- ** timestep

-- | Take the given number of steps.  Negative means step back.
timestep :: ScoreTime -> TimeStep.TimeStep
    -> [Int] -- ^ pick the first steps that return Just
    -> Derive.Deriver ScoreTime
timestep :: ScoreTime -> TimeStep -> [Int] -> Deriver ScoreTime
timestep ScoreTime
start TimeStep
ts [Int]
steps = do
    (BlockId
block_id, Int
tracknum) <- Deriver (BlockId, Int)
Internal.get_current_tracknum
    forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require (Text
"no valid timestep from " forall a. Semigroup a => a -> a -> a
<> forall a. ShowVal a => a -> Text
ShowVal.show_val ScoreTime
start)
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. HasCallStack => StateId a -> Deriver a
Derive.eval_ui
            (forall (m :: * -> *) a. Monad m => [m (Maybe a)] -> m (Maybe a)
firstJusts [forall (m :: * -> *).
M m =>
Int
-> TimeStep -> BlockId -> Int -> ScoreTime -> m (Maybe ScoreTime)
TimeStep.step_from Int
step TimeStep
ts BlockId
block_id Int
tracknum ScoreTime
start |
                Int
step <- [Int]
steps])

-- | Get the timestep duration from the given point.  This tries first to
-- step forward, and then back.  This is because typically you use this to
-- configure duration for a call, and it's confusing when the call stops
-- working at the end of the block.
meter_duration :: ScoreTime -> Meter.Rank -> Int
    -> Derive.Deriver ScoreTime
meter_duration :: ScoreTime -> Rank -> Int -> Deriver ScoreTime
meter_duration ScoreTime
start Rank
rank Int
steps = do
    ScoreTime
end <- ScoreTime -> TimeStep -> [Int] -> Deriver ScoreTime
timestep ScoreTime
start TimeStep
ts (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
*Int
steps) [Int
1, -Int
1])
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs (ScoreTime
end forall a. Num a => a -> a -> a
- ScoreTime
start)
    where
    ts :: TimeStep
ts = Step -> TimeStep
TimeStep.time_step forall a b. (a -> b) -> a -> b
$ MarklistMatch -> Rank -> Step
TimeStep.RelativeMark MarklistMatch
TimeStep.match_meter Rank
rank

-- | Duration of a single timestep, starting here.
timestep_duration :: Derive.PassedArgs a -> Meter.Rank
    -> Derive.Deriver ScoreTime
timestep_duration :: forall a. PassedArgs a -> Rank -> Deriver ScoreTime
timestep_duration PassedArgs a
args Rank
step = ScoreTime -> Rank -> Int -> Deriver ScoreTime
meter_duration (forall a. PassedArgs a -> ScoreTime
Args.start PassedArgs a
args) Rank
step Int
1


-- * general purpose types

-- | This is for arguments which can be high or low.
data UpDown = Up | Down deriving (Int -> UpDown -> ShowS
[UpDown] -> ShowS
UpDown -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpDown] -> ShowS
$cshowList :: [UpDown] -> ShowS
show :: UpDown -> String
$cshow :: UpDown -> String
showsPrec :: Int -> UpDown -> ShowS
$cshowsPrec :: Int -> UpDown -> ShowS
Show, Int -> UpDown
UpDown -> Int
UpDown -> [UpDown]
UpDown -> UpDown
UpDown -> UpDown -> [UpDown]
UpDown -> UpDown -> UpDown -> [UpDown]
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 :: UpDown -> UpDown -> UpDown -> [UpDown]
$cenumFromThenTo :: UpDown -> UpDown -> UpDown -> [UpDown]
enumFromTo :: UpDown -> UpDown -> [UpDown]
$cenumFromTo :: UpDown -> UpDown -> [UpDown]
enumFromThen :: UpDown -> UpDown -> [UpDown]
$cenumFromThen :: UpDown -> UpDown -> [UpDown]
enumFrom :: UpDown -> [UpDown]
$cenumFrom :: UpDown -> [UpDown]
fromEnum :: UpDown -> Int
$cfromEnum :: UpDown -> Int
toEnum :: Int -> UpDown
$ctoEnum :: Int -> UpDown
pred :: UpDown -> UpDown
$cpred :: UpDown -> UpDown
succ :: UpDown -> UpDown
$csucc :: UpDown -> UpDown
Enum, UpDown
forall a. a -> a -> Bounded a
maxBound :: UpDown
$cmaxBound :: UpDown
minBound :: UpDown
$cminBound :: UpDown
Bounded, UpDown -> UpDown -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpDown -> UpDown -> Bool
$c/= :: UpDown -> UpDown -> Bool
== :: UpDown -> UpDown -> Bool
$c== :: UpDown -> UpDown -> Bool
Eq, Eq UpDown
UpDown -> UpDown -> Bool
UpDown -> UpDown -> Ordering
UpDown -> UpDown -> UpDown
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 :: UpDown -> UpDown -> UpDown
$cmin :: UpDown -> UpDown -> UpDown
max :: UpDown -> UpDown -> UpDown
$cmax :: UpDown -> UpDown -> UpDown
>= :: UpDown -> UpDown -> Bool
$c>= :: UpDown -> UpDown -> Bool
> :: UpDown -> UpDown -> Bool
$c> :: UpDown -> UpDown -> Bool
<= :: UpDown -> UpDown -> Bool
$c<= :: UpDown -> UpDown -> Bool
< :: UpDown -> UpDown -> Bool
$c< :: UpDown -> UpDown -> Bool
compare :: UpDown -> UpDown -> Ordering
$ccompare :: UpDown -> UpDown -> Ordering
Ord)

invert :: UpDown -> UpDown
invert :: UpDown -> UpDown
invert UpDown
Up = UpDown
Down
invert UpDown
Down = UpDown
Up

instance Pretty UpDown where pretty :: UpDown -> Text
pretty = forall a. Show a => a -> Text
showt
instance Typecheck.Typecheck UpDown
instance Typecheck.ToVal UpDown
instance ShowVal.ShowVal UpDown where
    show_val :: UpDown -> Text
show_val UpDown
Up = Text
"u"
    show_val UpDown
Down = Text
"d"

data Hand = L | R deriving (Int -> Hand -> ShowS
[Hand] -> ShowS
Hand -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hand] -> ShowS
$cshowList :: [Hand] -> ShowS
show :: Hand -> String
$cshow :: Hand -> String
showsPrec :: Int -> Hand -> ShowS
$cshowsPrec :: Int -> Hand -> ShowS
Show, Int -> Hand
Hand -> Int
Hand -> [Hand]
Hand -> Hand
Hand -> Hand -> [Hand]
Hand -> Hand -> Hand -> [Hand]
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 :: Hand -> Hand -> Hand -> [Hand]
$cenumFromThenTo :: Hand -> Hand -> Hand -> [Hand]
enumFromTo :: Hand -> Hand -> [Hand]
$cenumFromTo :: Hand -> Hand -> [Hand]
enumFromThen :: Hand -> Hand -> [Hand]
$cenumFromThen :: Hand -> Hand -> [Hand]
enumFrom :: Hand -> [Hand]
$cenumFrom :: Hand -> [Hand]
fromEnum :: Hand -> Int
$cfromEnum :: Hand -> Int
toEnum :: Int -> Hand
$ctoEnum :: Int -> Hand
pred :: Hand -> Hand
$cpred :: Hand -> Hand
succ :: Hand -> Hand
$csucc :: Hand -> Hand
Enum, Hand
forall a. a -> a -> Bounded a
maxBound :: Hand
$cmaxBound :: Hand
minBound :: Hand
$cminBound :: Hand
Bounded, Hand -> Hand -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hand -> Hand -> Bool
$c/= :: Hand -> Hand -> Bool
== :: Hand -> Hand -> Bool
$c== :: Hand -> Hand -> Bool
Eq, Eq Hand
Hand -> Hand -> Bool
Hand -> Hand -> Ordering
Hand -> Hand -> Hand
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 :: Hand -> Hand -> Hand
$cmin :: Hand -> Hand -> Hand
max :: Hand -> Hand -> Hand
$cmax :: Hand -> Hand -> Hand
>= :: Hand -> Hand -> Bool
$c>= :: Hand -> Hand -> Bool
> :: Hand -> Hand -> Bool
$c> :: Hand -> Hand -> Bool
<= :: Hand -> Hand -> Bool
$c<= :: Hand -> Hand -> Bool
< :: Hand -> Hand -> Bool
$c< :: Hand -> Hand -> Bool
compare :: Hand -> Hand -> Ordering
$ccompare :: Hand -> Hand -> Ordering
Ord)

other_hand :: Hand -> Hand
other_hand :: Hand -> Hand
other_hand Hand
L = Hand
R
other_hand Hand
R = Hand
L

instance Pretty Hand where pretty :: Hand -> Text
pretty = forall a. Show a => a -> Text
showt
instance Typecheck.Typecheck Hand
instance Typecheck.ToVal Hand
instance ShowVal.ShowVal Hand where
    show_val :: Hand -> Text
show_val Hand
L = Text
"l"
    show_val Hand
R = Text
"r"