-- Copyright 2020 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 -- | Ad-hoc parsing for note tracks. This is a bit hacky because it's trying -- to guess syntactically how an expression will be evaluated, but it's -- convenient to do it this way, because otherwise I need to either have a -- special kind of evaluation, or I need to have evaluate emit metadata, and -- then wait for a full derive to complete. In addition, expressions that are -- being edited might not parse, or their caller might fail, or something. module Cmd.NoteTrackParse where import qualified Data.Map as Map import qualified Util.Lists as Lists import qualified Derive.Eval as Eval import qualified Derive.Expr as Expr import qualified Derive.Parse as Parse import qualified Ui.Event as Event import qualified Ui.Events as Events import qualified Ui.Id as Id import qualified Ui.Ui as Ui import Global import Types track_block_calls :: Ui.M m => Bool -> BlockId -> TrackId -> m [(Event.Event, NonEmpty BlockId)] track_block_calls :: forall (m :: * -> *). M m => Bool -> BlockId -> TrackId -> m [(Event, NonEmpty BlockId)] track_block_calls Bool look_in_args BlockId block_id TrackId track_id = do [Event] events <- Events -> [Event] Events.ascending forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *). M m => TrackId -> m Events Ui.get_events TrackId track_id Text -> Maybe BlockId to_bid <- forall (m :: * -> *). M m => Maybe BlockId -> m (Text -> Maybe BlockId) get_to_block_id (forall a. a -> Maybe a Just BlockId block_id) let bids :: [[BlockId]] bids = forall a b. (a -> b) -> [a] -> [b] map (forall a. Bool -> (Text -> Maybe a) -> Text -> [a] block_calls_of Bool look_in_args Text -> Maybe BlockId to_bid forall b c a. (b -> c) -> (a -> b) -> a -> c . Event -> Text Event.text) [Event] events forall (m :: * -> *) a. Monad m => a -> m a return [(Event event, BlockId b forall a. a -> [a] -> NonEmpty a :| [BlockId] bs) | (Event event, BlockId b:[BlockId] bs) <- forall a b. [a] -> [b] -> [(a, b)] zip [Event] events [[BlockId]] bids] expr_block_calls :: Ui.M m => Bool -> BlockId -> Text -> m [BlockId] expr_block_calls :: forall (m :: * -> *). M m => Bool -> BlockId -> Text -> m [BlockId] expr_block_calls Bool look_in_args BlockId caller Text expr = do Text -> Maybe BlockId to_bid <- forall (m :: * -> *). M m => Maybe BlockId -> m (Text -> Maybe BlockId) get_to_block_id (forall a. a -> Maybe a Just BlockId caller) forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a. Bool -> (Text -> Maybe a) -> Text -> [a] block_calls_of Bool look_in_args Text -> Maybe BlockId to_bid Text expr -- | Try to to figure out any blocks that are referenced in the expression. -- -- This doesn't use the full Derive.Parse machinery, but is simple and doesn't -- require the text to be fully parseable. block_calls_of :: Bool -- ^ If True, and the call wasn't a block, see if any -- of the arguments name blocks. This is for calls like @alt@, which take -- blocks as arguments. -> (Text -> Maybe a) -> Text -> [a] block_calls_of :: forall a. Bool -> (Text -> Maybe a) -> Text -> [a] block_calls_of Bool look_in_args Text -> Maybe a to_bid Text expr = case [Text] syms of [] -> [] Text b : [Text] bs -> case Text -> Maybe a to_bid Text b of Maybe a Nothing -> forall a b. (a -> Maybe b) -> [a] -> [b] mapMaybe Text -> Maybe a to_bid [Text] bs Just a block_id -> [a block_id] where syms :: [Text] syms = (if Bool look_in_args then forall a. a -> a id else forall a. Int -> [a] -> [a] take Int 1) forall a b. (a -> b) -> a -> b $ Text -> [Text] possible_block_calls Text expr get_to_block_id :: Ui.M m => Maybe BlockId -> m (Text -> Maybe BlockId) get_to_block_id :: forall (m :: * -> *). M m => Maybe BlockId -> m (Text -> Maybe BlockId) get_to_block_id Maybe BlockId caller = do Map BlockId Block blocks <- forall (m :: * -> *) a. M m => (State -> a) -> m a Ui.gets State -> Map BlockId Block Ui.state_blocks Namespace ns <- forall (m :: * -> *). M m => m Namespace Ui.get_namespace forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a. Map BlockId a -> Namespace -> Maybe BlockId -> Text -> Maybe BlockId to_block_id Map BlockId Block blocks Namespace ns Maybe BlockId caller -- | If the first word names a block, then it's probably a block call with -- args, so return just that. Otherwise, return any argument that names -- a block. to_block_id :: Map BlockId a -> Id.Namespace -> Maybe BlockId -> Text -> (Maybe BlockId) to_block_id :: forall a. Map BlockId a -> Namespace -> Maybe BlockId -> Text -> Maybe BlockId to_block_id Map BlockId a blocks Namespace ns Maybe BlockId caller = BlockId -> Maybe BlockId valid forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< Namespace -> Maybe BlockId -> Symbol -> Maybe BlockId Eval.call_to_block_id Namespace ns Maybe BlockId caller forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Symbol Expr.Symbol where valid :: BlockId -> Maybe BlockId valid BlockId block_id | Just a _ <- forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup BlockId block_id Map BlockId a blocks = forall a. a -> Maybe a Just BlockId block_id | Bool otherwise = forall a. Maybe a Nothing possible_block_calls :: Text -> [Text] possible_block_calls :: Text -> [Text] possible_block_calls = forall a. a -> Maybe a -> a fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. [a] -> Maybe a Lists.last forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> [[Text]] Parse.split_pipeline