content: -- 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 #-}
  {- | A TimeStep is an abstract description of a ScoreTime interval.
  
      It's used to advance a cursor, snap a selection, set a note duration, etc.
  -}
  module Cmd.TimeStep (
      -- * TimeStep
      TimeStep, time_step, event_step, from_list, to_list
      , modify_rank
      , match_meter
      , event_edge
      , rank
      , Step(..), Tracks(..)
      , MarklistMatch(..)
      , Direction(..)
      , show_time_step, parse_time_step, show_direction
      , parse_rank
  
      -- * step
      , snap
      , step_from, rewind, advance, direction
      , duration_at
      , get_points_from
  
  #ifdef TESTING
      , ascending_points, descending_points
  #endif
  ) where
  import qualified Data.List.Ordered as Ordered
  import qualified Data.Map as Map
  import qualified Data.Text as Text
  
  import qualified Util.Lists as Lists
  import qualified Util.P as P
  import qualified Util.Parse as Parse
  
  import qualified Ui.Event as Event
  import qualified Ui.Events as Events
  import qualified Ui.Meter.Mark as Mark
  import qualified Ui.Meter.Meter as Meter
  import qualified Ui.Ruler as Ruler
  import qualified Ui.ScoreTime as ScoreTime
  import qualified Ui.Ui as Ui
  
  import           Global
  import           Types
  
  
  -- | A TimeStep is the union of a set of Steps.
  newtype TimeStep = TimeStep [Step]
      deriving (Eq, Show)
  
  time_step :: Step -> TimeStep
  time_step = TimeStep . (:[])
  
  -- | Step to start and end of events.
  event_step :: TimeStep
  event_step = from_list [EventStart CurrentTrack, EventEnd CurrentTrack]
  
  from_list :: [Step] -> TimeStep
  from_list = TimeStep
  
  to_list :: TimeStep -> [Step]
  to_list (TimeStep steps) = steps
  
  modify_rank :: (Meter.Rank -> Meter.Rank) -> TimeStep -> TimeStep
  modify_rank f = from_list . map modify . to_list
      where
      modify (AbsoluteMark m r) = AbsoluteMark m (f r)
      modify (RelativeMark m r) = RelativeMark m (f r)
      modify step = step
  
  -- | Match on the meter marklist, which is the usual thing to do.
  match_meter :: MarklistMatch
  match_meter = NamedMarklists [Ruler.meter_name]
  
  event_edge :: TimeStep
  event_edge =
      TimeStep [EventStart CurrentTrack, EventEnd CurrentTrack, BlockEdge]
  
  rank :: Meter.Rank -> TimeStep
  rank = time_step . AbsoluteMark match_meter
  
  -- | The possible matchers for a TimeStep.
  data Step =
       -- | Step a certain amount of time.  It's measured relative to the current
       -- selection, rather than absolute from the beginning of the block.
      Duration ScoreTime
      -- | Until the next mark that matches.
      | AbsoluteMark MarklistMatch Meter.Rank
      -- | Until next matching mark + offset from previous mark.
      | RelativeMark MarklistMatch Meter.Rank
      -- | Until the end or beginning of the block.
      | BlockEdge
      -- | Until event edges.  EventStart is after EventEnd if the duration is
      -- negative.
      | EventStart Tracks
      | EventEnd Tracks
      deriving (Eq, Show)
  
  -- | Events of which tracks the event time step should use.
  data Tracks = CurrentTrack | AllTracks | TrackNums [TrackNum]
      deriving (Eq, Show)
  
  data MarklistMatch = AllMarklists | NamedMarklists [Ruler.Name]
      deriving (Eq, Show)
  
  -- | Another way to express a 'step_from' of 1 or -1.
  data Direction = Advance | Rewind deriving (Eq, Show)
  
  -- | Convert a TimeStep to a compact and yet somehow still somewhat readable
  -- representation.
  show_time_step :: TimeStep -> Text
  show_time_step (TimeStep steps)
      -- Abbreviate to keep the status line shorter.
      | TimeStep steps == event_edge = "E"
      | otherwise = Text.intercalate ";" (map show_step steps)
      where
      -- The keywords and symbols are chosen carefully to allow unambiguous
      -- parsing.
      show_step step = case step of
          Duration pos -> "d:" <> pretty pos
          RelativeMark mlists rank ->
              "r:" <> show_marklists mlists <> Meter.rank_name rank
          BlockEdge -> "END"
          EventStart tracks -> "start" <> show_tracks tracks
          EventEnd tracks -> "end" <> show_tracks tracks
          AbsoluteMark mlists rank ->
              show_marklists mlists <> Meter.rank_name rank
      show_marklists AllMarklists = ""
      show_marklists (NamedMarklists mlists) = Text.intercalate "," mlists <> "|"
      show_tracks CurrentTrack = ""
      show_tracks AllTracks = "s"
      show_tracks (TrackNums tracks) =
          "s:" <> Text.intercalate "," (map showt tracks)
  
  -- | Parse that curiously somewhat readable representation back to a TimeStep.
  parse_time_step :: Text -> Either Text TimeStep
  parse_time_step = Parse.parse p_time_step
      where
      p_time_step = TimeStep <$> P.sepBy p_step (P.char ';')
      -- P.choice must backtrack because AbsoluteMark parses can overlap.
      p_step = P.choice $ map P.try
          [ str "d:" *> (Duration <$>
              (ScoreTime.from_double
                  <$> (Parse.p_float <* P.char ScoreTime.suffix)))
          , str "r:" *> (RelativeMark <$> p_marklists <*> parse_rank)
          , str "END" *> return BlockEdge
          , str "start" *> (EventStart <$> p_tracks)
          , str "end" *> (EventEnd <$> p_tracks)
          , AbsoluteMark <$> p_marklists <*> parse_rank
          ]
      p_marklists =
          P.try ((NamedMarklists <$> P.sepBy p_name (P.char ',')) <* P.char '|')
          <|> return AllMarklists
      p_name = txt <$> P.some (P.lowerChar <|> P.char '-')
      p_tracks = P.option CurrentTrack $
          P.try (TrackNums <$> (str "s:" *> p_tracknums))
          <|> P.char 's' *> return AllTracks
      p_tracknums = P.sepBy Parse.p_nat (P.char ',')
      str = P.string
  
  parse_rank :: Parse.Parser Meter.Rank
  parse_rank = P.choice $ map P.try
      [P.string name *> return rank | (rank, name) <- Meter.rank_names]
  
  show_direction :: Direction -> Text
  show_direction Advance = "+"
  show_direction Rewind = "-"
  
  -- * snap
  
  -- | Given a pos, the point on a timestep at or previous to that pos.  If
  -- there was no snap point, the pos is return unchanged.
  snap :: Ui.M m => TimeStep -> BlockId -> TrackNum
      -> Maybe TrackTime -- ^ Last sel pos, needed to snap relative steps like
      -- 'Duration' and 'RelativeMark'.
      -> TrackTime -> m TrackTime
  snap tstep block_id tracknum prev_pos pos =
      -- I only need to step from prev_pos if there's a RelativeMark in the tstep.
      -- Otherwise, I can be a bit more efficient and snap pos directly.
      fromMaybe pos <$> snap_from (if any is_relative (to_list tstep)
          then fromMaybe pos prev_pos else pos)
      where
      snap_from p
          | pos > p = -- Advance p until one before pos.
              Lists.head . Lists.dropBefore id pos <$>
                  get_points_from Advance block_id tracknum p tstep
          | otherwise = -- Rewind p until before pos.
              Lists.head . dropWhile (>pos) <$>
                  get_points_from Rewind block_id tracknum p tstep
      is_relative (Duration {}) = True
      is_relative (RelativeMark {}) = True
      is_relative _ = False
  
  -- * step
  
  rewind :: Ui.M m => TimeStep -> BlockId -> TrackNum -> TrackTime
      -> m (Maybe TrackTime)
  rewind = step_from (-1)
  
  advance :: Ui.M m => TimeStep -> BlockId -> TrackNum -> TrackTime
      -> m (Maybe TrackTime)
  advance = step_from 1
  
  direction :: Direction -> Int
  direction Advance = 1
  direction Rewind = -1
  
  duration_at :: Ui.M m => BlockId -> TrackNum -> TrackTime -> TimeStep
      -> m (Maybe ScoreTime)
  duration_at block_id tracknum pos tstep = do
      pre <- get_points_from Rewind block_id tracknum pos tstep
      post <- get_points_from Advance block_id tracknum pos tstep
      return $ case (pre, dropWhile (==pos) post) of
          (t0 : _, t1 : _) -> Just (t1 - t0)
          _ -> Nothing
  
  -- | Step in the given direction from the given position, or Nothing if
  -- there is no step from that point.  This may return a point past the end of
  -- the ruler, or before 0, so if the caller wants to step the selection it
  -- should make sure to limit the value.  The reason is that this is also used
  -- to get e.g. the duration of a whole note at a given point, and that should
  -- work even if the given point is near the end of the ruler.
  step_from :: Ui.M m => Int -> TimeStep -> BlockId -> TrackNum
      -> TrackTime -> m (Maybe TrackTime)
  step_from steps tstep block_id tracknum start = extract <$>
      get_points_from (if steps >= 0 then Advance else Rewind) block_id tracknum
          start tstep
      where
      extract = Lists.head
          . if steps == 0 then id else drop (abs steps - 1) . dropWhile (==start)
  
  get_points_from :: Ui.M m => Direction -> BlockId -> TrackNum -> TrackTime
      -> TimeStep -> m [TrackTime]
  get_points_from dir block_id tracknum start tstep =
      merge_points dir <$> mapM (get block_id tracknum start) (to_list tstep)
      where
      get = case dir of
          Advance -> ascending_points
          Rewind -> descending_points
  
  -- | Step points ascending from the given time.  Includes the start
  -- point.
  ascending_points :: Ui.M m => BlockId -> TrackNum -> TrackTime -> Step
      -> m [TrackTime]
  ascending_points block_id tracknum start step =
      dropWhile (<start) <$> case step of
          Duration t -> do
              end <- Ui.block_ruler_end block_id
              return $ Lists.range start end t
          AbsoluteMark match rank ->
              get_marks Advance False match rank start <$>
                  get_ruler block_id tracknum
          RelativeMark match rank ->
              shift . get_marks Advance True match rank start <$>
                  get_ruler block_id tracknum
          BlockEdge -> do
              end <- Ui.block_ruler_end block_id
              return [0, end]
          EventStart tracks ->
              track_events Advance True block_id tracknum start tracks
          EventEnd tracks ->
              track_events Advance False block_id tracknum start tracks
      where
      shift [] = []
      shift (p:ps)
          | p == start = p : ps
          | otherwise = map (+ (start-p)) (p:ps)
  
  -- | Step points descending from the given time.  Includes the start
  -- point.
  descending_points :: Ui.M m => BlockId -> TrackNum -> TrackTime -> Step
      -> m [TrackTime]
  descending_points block_id tracknum start step =
      dropWhile (>start) <$> case step of
          Duration t -> return $ Lists.range start 0 (-t)
          AbsoluteMark match rank ->
              get_marks Rewind True match rank start <$>
                  get_ruler block_id tracknum
          RelativeMark match rank ->
              shift . get_marks Rewind True match rank start <$>
                  get_ruler block_id tracknum
          BlockEdge -> do
              end <- Ui.block_ruler_end block_id
              return [end, 0]
          EventStart tracks ->
              track_events Rewind True block_id tracknum start tracks
          EventEnd tracks ->
              track_events Rewind False block_id tracknum start tracks
      where
      shift [] = []
      shift (p:ps)
          | p == start = p : ps
          | otherwise = map (+ (start-p)) (p:ps)
  
  track_events :: Ui.M m => Direction -> Bool
      -> BlockId -> TrackNum -> TrackTime -> Tracks -> m [TrackTime]
  track_events dir event_start block_id tracknum start = \case
      AllTracks -> do
          track_ids <- Ui.track_ids_of block_id
          merge_points dir <$> mapM get_times track_ids
      CurrentTrack -> get_times =<< Ui.get_event_track_at block_id tracknum
      TrackNums tracknums -> do
          track_ids <- mapM (Ui.get_event_track_at block_id) tracknums
          merge_points dir <$> mapM get_times track_ids
      where
      event_time = if event_start then Event.start else Event.end
      get_times = fmap (map event_time . get_events) . Ui.get_events
      get_events = case dir of
          Advance -> if event_start then Events.at_after start
              else snd . Events.split_at_before start
          Rewind -> at_before start
      at_before p events = case post of
              e : _ | Event.start e == p -> e : pre
              _ -> pre
          where (pre, post) = Events.split_lists p events
  
  merge_points :: Direction -> [[TrackTime]] -> [TrackTime]
  merge_points Advance = Lists.dropDups id . Lists.mergeLists id
  merge_points Rewind = Lists.dropDups id . merge_desc
  
  merge_desc :: [[TrackTime]] -> [TrackTime]
  merge_desc = foldr (Ordered.mergeBy (flip compare)) []
  
  -- | Get all marks from the marklists that match the proper names and
  -- merge their marks into one list.
  get_marks :: Direction -> Bool -> MarklistMatch -> Meter.Rank -> TrackTime
      -> Ruler.Marklists -> [TrackTime]
  get_marks dir minus1 match rank start marklists =
      merge_points dir $ map extract matching
      where
      extract = case dir of
          Advance
              | minus1 -> ascending1
              | otherwise -> with_rank . Mark.ascending start
          Rewind
              | minus1 -> descending1
              | otherwise -> with_rank . Mark.descending start
      matching = map snd $ case match of
          AllMarklists -> Map.elems marklists
          NamedMarklists names -> mapMaybe (flip Map.lookup marklists) names
      ascending1 mlist
          | Just p <- Lists.head marks, p == start = marks
          | otherwise = maybe marks (:marks) $
              Lists.head (with_rank $ Mark.descending start mlist)
          where marks = with_rank $ Mark.ascending start mlist
      descending1 mlist = maybe marks (:marks) $
          Lists.head (with_rank $ Mark.ascending start mlist)
          where marks = with_rank $ Mark.descending start mlist
      with_rank = map fst . filter ((<=rank) . Mark.mark_rank . snd)
  
  get_ruler :: Ui.M m => BlockId -> TrackNum -> m Ruler.Marklists
  get_ruler block_id tracknum = do
      ruler_id <- fromMaybe Ui.no_ruler <$> Ui.ruler_track_at block_id tracknum
      Ruler.ruler_marklists <$> Ui.get_ruler ruler_id
  