-- 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"