-- 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 {-# LANGUAGE CPP #-} {- | Utilities for "Derive.Call.Block". Derivation of a block is much more complicated than it might first appear. This can cause score code to be evaluated more times than you think it should be. One culprit is evaluating tracks for control signals for signal render. Under some circumstances, the track's normal control output can be directly reused as the signal render, but in many cases it has to be evaluated again. This is further complicated by the presence of inversion and orphans. -} module Derive.Call.BlockUtil ( note_deriver, control_deriver , capture_null_control , derive_tracks , has_top_tempo_track #ifdef TESTING , derive_tree #endif ) where import qualified Data.Tree as Tree import qualified Util.Lists as Lists import qualified Util.Log as Log import qualified Util.Trees as Trees import qualified Derive.Cache as Cache import qualified Derive.Control as Control import qualified Derive.Controls as Controls import qualified Derive.Derive as Derive import qualified Derive.Deriver.Internal as Internal import qualified Derive.EnvKey as EnvKey import qualified Derive.EvalTrack as EvalTrack import qualified Derive.Expr as Expr import qualified Derive.LEvent as LEvent import qualified Derive.Note as Note import qualified Derive.PSignal as PSignal import qualified Derive.ParseTitle as ParseTitle import qualified Derive.Score as Score import qualified Derive.ScoreT as ScoreT import qualified Derive.ShowVal as ShowVal import qualified Derive.Stack as Stack import qualified Derive.Stream as Stream import qualified Derive.Tempo as Tempo import qualified Perform.Signal as Signal import qualified Ui.Event as Event import qualified Ui.Events as Events import qualified Ui.TrackTree as TrackTree import qualified Ui.Ui as Ui import qualified Ui.UiConfig as UiConfig import Global import Types note_deriver :: BlockId -> Derive.NoteDeriver note_deriver :: BlockId -> NoteDeriver note_deriver BlockId block_id = do (EventsTree tree, (TrackTime, TrackTime) block_range) <- forall a. HasCallStack => StateId a -> Deriver a Derive.eval_ui forall a b. (a -> b) -> a -> b $ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *). M m => BlockId -> m EventsTree TrackTree.block_events_tree BlockId block_id forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall (m :: * -> *). M m => BlockId -> m (TrackTime, TrackTime) Ui.block_logical_range BlockId block_id forall a. TrackTime -> Deriver a -> Deriver a with_per_block_state (forall a b. (a, b) -> b snd (TrackTime, TrackTime) block_range) forall a b. (a -> b) -> a -> b $ (TrackTime, TrackTime) -> EventsTree -> NoteDeriver derive_tree (TrackTime, TrackTime) block_range EventsTree tree -- | Reset Dynamic state for a new block. with_per_block_state :: TrackTime -> Derive.Deriver a -> Derive.Deriver a with_per_block_state :: forall a. TrackTime -> Deriver a -> Deriver a with_per_block_state TrackTime end = forall {a}. Deriver a -> Deriver a clear forall b c a. (b -> c) -> (a -> b) -> a -> c . forall val a. ToVal val => Text -> val -> Deriver a -> Deriver a Derive.with_val Text EnvKey.block_end TrackTime end where clear :: Deriver a -> Deriver a clear = forall a. (Dynamic -> Dynamic) -> Deriver a -> Deriver a Internal.local forall a b. (a -> b) -> a -> b $ \Dynamic state -> Dynamic state { state_note_track :: Maybe (BlockId, TrackId) Derive.state_note_track = forall a. Maybe a Nothing , state_pitch_map :: Maybe (Maybe PSignal, [Msg]) Derive.state_pitch_map = forall a. Maybe a Nothing -- set by 'with_pitch_map' below } -- * control deriver -- | Control blocks are very restricted: they should consist of a single -- branch ending in a track with a @%@ title, which is the default control, -- which should have been set by the calling track. If the requirements are -- met, a fake note track will be appended to make this a valid note block, -- with a single note event whose only job is to collect the the default -- control. control_deriver :: BlockId -> Ui.StateId Derive.ControlDeriver control_deriver :: BlockId -> StateId ControlDeriver control_deriver BlockId block_id = do EventsTree tree <- forall (m :: * -> *). M m => BlockId -> m EventsTree TrackTree.block_events_tree BlockId block_id (TrackTime, TrackTime) block_range <- forall (m :: * -> *). M m => BlockId -> m (TrackTime, TrackTime) Ui.block_logical_range BlockId block_id case TrackTime -> EventsTree -> Either Text EventsTree check_control_tree (forall a b. (a, b) -> b snd (TrackTime, TrackTime) block_range) EventsTree tree of Left Text err -> forall (m :: * -> *) a. (HasCallStack, M m) => Text -> m a Ui.throw forall a b. (a -> b) -> a -> b $ Text "control block skeleton malformed: " forall a. Semigroup a => a -> a -> a <> Text err Right EventsTree tree -> forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a. TrackTime -> Deriver a -> Deriver a with_per_block_state (forall a b. (a, b) -> b snd (TrackTime, TrackTime) block_range) forall a b. (a -> b) -> a -> b $ (TrackTime, TrackTime) -> EventsTree -> ControlDeriver derive_control_tree (TrackTime, TrackTime) block_range EventsTree tree -- | Name of the call for the control deriver hack. capture_null_control :: Expr.Symbol capture_null_control :: Symbol capture_null_control = Symbol "capture-null-control" -- | Ensure the tree meets the requirements documented by 'control_deriver' -- and append the fake note track if it does. check_control_tree :: ScoreTime -> TrackTree.EventsTree -> Either Text TrackTree.EventsTree check_control_tree :: TrackTime -> EventsTree -> Either Text EventsTree check_control_tree TrackTime block_end EventsTree forest = case EventsTree forest of [] -> forall a b. a -> Either a b Left Text "empty block" [Tree.Node Track track []] | Track -> Text TrackTree.track_title Track track forall a. Eq a => a -> a -> Bool == Text "%" -> forall a b. b -> Either a b Right [forall a. a -> [Tree a] -> Tree a Tree.Node Track track [forall a. a -> [Tree a] -> Tree a Tree.Node Track capture_track []]] | Bool otherwise -> forall a b. a -> Either a b Left forall a b. (a -> b) -> a -> b $ Text "skeleton must end in % track, ends with " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> Text showt (Track -> Text TrackTree.track_title Track track) [Tree.Node Track track EventsTree subs] -> do EventsTree subs <- TrackTime -> EventsTree -> Either Text EventsTree check_control_tree TrackTime block_end EventsTree subs forall (m :: * -> *) a. Monad m => a -> m a return [forall a. a -> [Tree a] -> Tree a Tree.Node Track track EventsTree subs] EventsTree tracks -> forall a b. a -> Either a b Left forall a b. (a -> b) -> a -> b $ Text "skeleton must have only a single branch, " forall a. Semigroup a => a -> a -> a <> Text "but there are multiple children: " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> Text showt (forall a b. (a -> b) -> [a] -> [b] map (Track -> Text TrackTree.track_title forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Tree a -> a Tree.rootLabel) EventsTree tracks) where events :: Events events = Event -> Events Events.singleton forall a b. (a -> b) -> a -> b $ TrackTime -> TrackTime -> Text -> Event Event.event TrackTime 0 TrackTime block_end (Symbol -> Text Expr.unsym Symbol capture_null_control) capture_track :: Track capture_track = Text -> Events -> TrackTime -> Track TrackTree.make_track Text ">" Events events TrackTime block_end derive_control_tree :: (ScoreTime, ScoreTime) -> TrackTree.EventsTree -> Derive.ControlDeriver derive_control_tree :: (TrackTime, TrackTime) -> EventsTree -> ControlDeriver derive_control_tree (TrackTime, TrackTime) block_range EventsTree tree = do -- There are an awful lot of things that can go wrong. I guess that's why -- this is a hack. Stream Event events <- (TrackTime, TrackTime) -> EventsTree -> NoteDeriver derive_tree (TrackTime, TrackTime) block_range EventsTree tree case forall a. Stream a -> ([a], [Msg]) Stream.partition Stream Event events of ([Event event], [Msg] logs) -> case Control -> Event -> Maybe (Typed Control) Score.event_control Control Controls.null Event event of Maybe (Typed Control) Nothing -> forall a. HasCallStack => Text -> Deriver a Derive.throw Text "control call didn't emit Controls.null" Just Typed Control signal -> forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a. [LEvent a] -> Stream a Stream.from_sorted_list forall a b. (a -> b) -> a -> b $ -- The calling control itself will be providing the type since -- types are at the level of the signal as a whole. forall a. a -> LEvent a LEvent.Event (forall a. Typed a -> a ScoreT.val_of Typed Control signal) forall a. a -> [a] -> [a] : forall a b. (a -> b) -> [a] -> [b] map forall a. Msg -> LEvent a LEvent.Log [Msg] logs ([Event] events, [Msg] logs) -> do Msg msg <- forall {a}. Show a => a -> Deriver Msg complain [Event] events forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a. [Msg] -> Stream a Stream.from_logs forall a b. (a -> b) -> a -> b $ Msg msg forall a. a -> [a] -> [a] : [Msg] logs where -- Or I could throw, but this way any other logs the block emitted will -- also be visible, and they might have something interesting. complain :: a -> Deriver Msg complain a events = Msg -> Deriver Msg Derive.initialize_log_msg forall a b. (a -> b) -> a -> b $ HasCallStack => Priority -> Maybe Stack -> Text -> Msg Log.msg Priority Log.Warn forall a. Maybe a Nothing forall a b. (a -> b) -> a -> b $ Text "control call should have emitted a single call to " forall a. Semigroup a => a -> a -> a <> forall a. ShowVal a => a -> Text ShowVal.show_val Symbol capture_null_control forall a. Semigroup a => a -> a -> a <> Text " which produces a single event, but got events: " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> Text showt a events -- ** implementation derive_tree :: (ScoreTime, ScoreTime) -> TrackTree.EventsTree -> Derive.NoteDeriver derive_tree :: (TrackTime, TrackTime) -> EventsTree -> NoteDeriver derive_tree (TrackTime, TrackTime) block_range EventsTree tree | Just Tree Track node <- EventsTree -> Maybe (Tree Track) has_top_tempo_track EventsTree tree = Bool -> Tree Track -> NoteDeriver derive_track Bool True Tree Track node | Bool otherwise = do -- Every block must have a tempo track as the topmost track. This is -- because Tempo.with_tempo sets up some stuff that every block needs, -- and because I need a TrackWarp for the tracks below. Y tempo <- Deriver State Error Y get_tempo forall a. Monoid a => Bool -> Maybe (TrackTime, TrackTime) -> Maybe TrackId -> Tempo -> Deriver a -> Deriver a Tempo.with_tempo Bool True (forall a. a -> Maybe a Just (TrackTime, TrackTime) block_range) forall a. Maybe a Nothing (forall {k} (kind :: k). Y -> Signal kind Signal.constant Y tempo) (EventsTree -> NoteDeriver derive_tracks EventsTree tree) where get_tempo :: Deriver State Error Y get_tempo = forall a. Typecheck a => Text -> Deriver (Maybe a) Derive.lookup_val Text EnvKey.tempo forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Maybe Y Nothing -> forall a. (Config -> a) -> Deriver a Derive.get_ui_config forall a b. (a -> b) -> a -> b $ Default -> Y UiConfig.default_tempo forall b c a. (b -> c) -> (a -> b) -> a -> c . Config -> Default UiConfig.config_default Just Y tempo -> forall (m :: * -> *) a. Monad m => a -> m a return Y tempo -- | Derive an EventsTree. derive_tracks :: TrackTree.EventsTree -> Derive.NoteDeriver derive_tracks :: EventsTree -> NoteDeriver derive_tracks = forall b a. Monoid b => (a -> b) -> [a] -> b mconcatMap (Bool -> Tree Track -> NoteDeriver derive_track Bool False) -- | Derive a single track node and any tracks below it. derive_track :: Bool -- ^ True if this is the single topmost track and is -- a tempo track. Ultimately this flag gets threaded all the way down to -- "Derive.Tempo". -> TrackTree.EventsNode -> Derive.NoteDeriver derive_track :: Bool -> Tree Track -> NoteDeriver derive_track Bool toplevel node :: Tree Track node@(Tree.Node Track track EventsTree subs) | Text -> Bool ParseTitle.is_note_track (Track -> Text TrackTree.track_title Track track) = forall {a}. Deriver a -> Deriver a with_stack forall a b. (a -> b) -> a -> b $ forall d. Cacheable d => Track -> Set TrackId -> Deriver (Stream d) -> Deriver (Stream d) Cache.track Track track (Tree Track -> Set TrackId TrackTree.track_children Tree Track node) forall a b. (a -> b) -> a -> b $ do Stream Event events <- forall {a}. Track -> Deriver a -> Deriver a with_voice Track track forall a b. (a -> b) -> a -> b $ forall a. Track -> EventsTree -> Deriver a -> Deriver a with_pitch_map Track track EventsTree subs forall a b. (a -> b) -> a -> b $ forall b a. b -> (a -> b) -> Maybe a -> b maybe forall a. a -> a id forall a. TrackId -> Deriver a -> Deriver a with_note_track (Track -> Maybe TrackId TrackTree.track_id Track track) forall a b. (a -> b) -> a -> b $ (EventsTree -> NoteDeriver) -> Tree Track -> NoteDeriver Note.d_note_track EventsTree -> NoteDeriver derive_tracks Tree Track node forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (Track -> Sliced TrackTree.track_sliced Track track forall a. Eq a => a -> a -> Bool == Sliced TrackTree.NotSliced) Deriver State Error () defragment forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (Stream Event -> Track -> Deriver State Error () Note.stash_signal_if_wanted Stream Event events) (Track -> EventsTree -> [Track] note_signal_tracks Track track EventsTree subs) forall (m :: * -> *) a. Monad m => a -> m a return Stream Event events | Bool otherwise = forall {a}. Deriver a -> Deriver a with_stack forall a b. (a -> b) -> a -> b $ Config -> Track -> NoteDeriver -> NoteDeriver Control.d_control_track (Bool -> Bool -> Config Control.Config Bool toplevel Bool True) Track track (EventsTree -> NoteDeriver derive_tracks EventsTree subs) where with_voice :: Track -> Deriver a -> Deriver a with_voice = forall b a. b -> (a -> b) -> Maybe a -> b maybe forall a. a -> a id (forall val a. ToVal val => Text -> val -> Deriver a -> Deriver a Derive.with_val Text EnvKey.track_voice) forall b c a. (b -> c) -> (a -> b) -> a -> c . Track -> Maybe Int TrackTree.track_voice defragment :: Deriver State Error () defragment = do Warp warp <- Deriver Warp Internal.get_warp (Collect -> Collect) -> Deriver State Error () Internal.modify_collect forall a b. (a -> b) -> a -> b $ Warp -> Collect -> Collect EvalTrack.defragment_track_signals Warp warp with_stack :: Deriver a -> Deriver a with_stack = forall b a. b -> (a -> b) -> Maybe a -> b maybe forall a. a -> a id forall a. TrackId -> Deriver a -> Deriver a Internal.with_stack_track (Track -> Maybe TrackId TrackTree.track_id Track track) with_note_track :: TrackId -> Derive.Deriver a -> Derive.Deriver a with_note_track :: forall a. TrackId -> Deriver a -> Deriver a with_note_track TrackId track_id Deriver a deriver = do Maybe BlockId maybe_block_id <- forall (t :: * -> *) (m :: * -> *) a. (Foldable t, MonadPlus m) => t (m a) -> m a msum forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a -> b) -> [a] -> [b] map Frame -> Maybe BlockId Stack.block_of forall b c a. (b -> c) -> (a -> b) -> a -> c . Stack -> [Frame] Stack.innermost forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Deriver Stack Internal.get_stack forall b a. b -> (a -> b) -> Maybe a -> b maybe forall a. a -> a id forall {a}. BlockId -> Deriver a -> Deriver a with Maybe BlockId maybe_block_id Deriver a deriver where with :: BlockId -> Deriver a -> Deriver a with BlockId block_id = forall a. (Dynamic -> Dynamic) -> Deriver a -> Deriver a Internal.local forall a b. (a -> b) -> a -> b $ \Dynamic state -> Dynamic state { state_note_track :: Maybe (BlockId, TrackId) Derive.state_note_track = forall a. a -> Maybe a Just (BlockId block_id, TrackId track_id) } -- | Extract tracks that might want to stash a signal. -- -- A note track can display a signal, extracted from the events it generates. -- But if the track has orphan sub-tracks, its events will be evaluated -- separately, either directly as orphans, or indirectly as the children of the -- non-orphan sections. At the moment it seems simpler to collect all the -- events of the whole set of tracks and consider them the output of all of -- them. note_signal_tracks :: TrackTree.Track -> TrackTree.EventsTree -> [TrackTree.Track] note_signal_tracks :: Track -> EventsTree -> [Track] note_signal_tracks Track track EventsTree subs = case Track -> Sliced TrackTree.track_sliced Track track of Sliced TrackTree.NotSliced -> Track track forall a. a -> [a] -> [a] : forall a. (a -> Bool) -> [a] -> [a] filter Track -> Bool is_note (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap forall a. Tree a -> [a] Tree.flatten EventsTree subs) Sliced _ -> [] where is_note :: Track -> Bool is_note = Text -> Bool ParseTitle.is_note_track forall b c a. (b -> c) -> (a -> b) -> a -> c . Track -> Text TrackTree.track_title -- | The tempo track, if the top level track is a tempo track. has_top_tempo_track :: [Tree.Tree TrackTree.Track] -> Maybe (Tree.Tree TrackTree.Track) has_top_tempo_track :: EventsTree -> Maybe (Tree Track) has_top_tempo_track EventsTree tree = case EventsTree tree of [node :: Tree Track node@(Tree.Node Track track EventsTree _)] | Track -> Bool is_tempo Track track -> forall a. a -> Maybe a Just Tree Track node EventsTree _ -> forall a. Maybe a Nothing where is_tempo :: Track -> Bool is_tempo = Text -> Bool ParseTitle.is_tempo_track forall b c a. (b -> c) -> (a -> b) -> a -> c . Track -> Text TrackTree.track_title -- * track pitch map -- | Given an event track, look for a pitch track below it, and derive it -- standalone. If there is none, then take 'Derive.state_pitch'. Put this -- into 'Derive.state_pitch_map'. with_pitch_map :: TrackTree.Track -> TrackTree.EventsTree -> Derive.Deriver a -> Derive.Deriver a with_pitch_map :: forall a. Track -> EventsTree -> Deriver a -> Deriver a with_pitch_map Track track EventsTree subs Deriver a deriver = case Track -> Sliced TrackTree.track_sliced Track track of Sliced TrackTree.NotSliced -> do (Maybe PSignal, [Msg]) pmap <- EventsTree -> Deriver (Maybe PSignal, [Msg]) get_pitch_map EventsTree subs forall a. (Dynamic -> Dynamic) -> Deriver a -> Deriver a Internal.local (\Dynamic state -> Dynamic state { state_pitch_map :: Maybe (Maybe PSignal, [Msg]) Derive.state_pitch_map = forall a. a -> Maybe a Just (Maybe PSignal, [Msg]) pmap }) Deriver a deriver Sliced _ -> Deriver a deriver get_pitch_map :: TrackTree.EventsTree -> Derive.Deriver (Maybe PSignal.PSignal, [Log.Msg]) get_pitch_map :: EventsTree -> Deriver (Maybe PSignal, [Msg]) get_pitch_map EventsTree subs = case EventsTree -> Maybe Track pitch_map_track EventsTree subs of Just Track pitch_track -> do State state <- forall st err. Deriver st err st Derive.get forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ State -> Track -> (Maybe PSignal, [Msg]) derive_pitch_map State state Track pitch_track Maybe Track Nothing -> do PSignal sig <- forall a. (Dynamic -> a) -> Deriver a Internal.get_dynamic Dynamic -> PSignal Derive.state_pitch forall (m :: * -> *) a. Monad m => a -> m a return (forall a. a -> Maybe a Just PSignal sig, []) -- | Derive the given pitch track lazily. -- -- It uses a hack similar to control blocks, e.g. 'derive_control_tree'. derive_pitch_map :: Derive.State -> TrackTree.Track -> (Maybe PSignal.PSignal, [Log.Msg]) derive_pitch_map :: State -> Track -> (Maybe PSignal, [Msg]) derive_pitch_map State state Track pitch_track = case Either Error PSignal result of Right PSignal sig -> (forall a. a -> Maybe a Just PSignal sig, [Msg] logs) Left Error err -> (forall a. Maybe a Nothing, Error -> Msg Derive.error_to_warn Error err forall a. a -> [a] -> [a] : [Msg] logs) where (Either Error PSignal result, State _, [Msg] logs) = forall st err a. st -> Deriver st err a -> RunResult st err a Derive.run State stripped (Track -> Deriver State Error PSignal derive Track pitch_track) stripped :: State stripped = State state { state_dynamic :: Dynamic Derive.state_dynamic = (State -> Dynamic Derive.state_dynamic State state) -- As documented by 'Derive.state_pitch_map'. { state_pitch_map :: Maybe (Maybe PSignal, [Msg]) Derive.state_pitch_map = forall a. Maybe a Nothing } } derive :: Track -> Deriver State Error PSignal derive Track pitch_track = do ([Event] events, [Msg] logs) <- forall a. Stream a -> ([a], [Msg]) Stream.partition forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall {a}. Deriver a -> Deriver a Internal.in_real_time (Config -> Track -> NoteDeriver -> NoteDeriver Control.d_control_track Config config Track pitch_track NoteDeriver capture) forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ forall (m :: * -> *). LogMonad m => Msg -> m () Log.write [Msg] logs forall a. HasCallStack => Text -> Maybe a -> Deriver a Derive.require Text "get_pitch_map: no event" forall a b. (a -> b) -> a -> b $ Event -> PSignal Score.event_pitch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. [a] -> Maybe a Lists.head [Event] events config :: Config config = Control.Config { config_toplevel_tempo :: Bool config_toplevel_tempo = Bool False , config_use_cache :: Bool config_use_cache = Bool False } capture :: Derive.NoteDeriver capture :: NoteDeriver capture = do PSignal pitch <- forall a. (Dynamic -> a) -> Deriver a Internal.get_dynamic Dynamic -> PSignal Derive.state_pitch forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a. a -> Stream a Stream.from_event forall a b. (a -> b) -> a -> b $ Event Score.empty_event { event_pitch :: PSignal Score.event_pitch = PSignal pitch } pitch_map_track :: TrackTree.EventsTree -> Maybe TrackTree.Track pitch_map_track :: EventsTree -> Maybe Track pitch_map_track = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a. Tree a -> a Tree.rootLabel forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. (a -> Bool) -> [Tree a] -> Maybe (Tree a) Trees.find Track -> Bool is_pitch where is_pitch :: Track -> Bool is_pitch = Text -> Bool ParseTitle.is_pitch_track forall b c a. (b -> c) -> (a -> b) -> a -> c . Track -> Text TrackTree.track_title