-- 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 DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
module Derive.Stack (
    Stack, empty, length, from_outermost, from_innermost
    , block, call, add, member, outermost, innermost
    , block_of, track_of, region_of, call_of
    , block_track_of, block_tracks_of, block_track_region_of
    , match
    , Frame(..), Serial
    , format_ui, pretty_ui, pretty_ui_, pretty_ui_inner
    , log_ui_frame

    -- * more specialized utils
    , track_regions

    -- * ui
    , UiFrame, to_ui, to_ui_innermost
    , unparse_ui_frame, unparse_ui_frame_, parse_ui_frame
) where
import qualified Prelude
import           Prelude hiding (length)
import qualified Control.DeepSeq as DeepSeq
import qualified Data.Aeson as Aeson
import qualified Data.Attoparsec.Text as A
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Vector as Vector

import qualified Text.Read as Read

import qualified Util.Num as Num
import qualified Util.ParseText as ParseText
import qualified Util.Pretty as Pretty
import qualified Util.Ranges as Ranges
import qualified Util.Seed as Seed
import qualified Util.Seq as Seq
import qualified Util.Serialize as Serialize

import qualified Ui.Id as Id
import qualified Ui.ScoreTime as ScoreTime

import           Global
import           Types


-- | The Stack is read in both inner -> outer and outer -> inner order.  Since
-- it's always modified at the innermost end, I keep it in inner -> outer
-- order.
--
-- I originally used "Data.Sequence" but it generates more garbage and
-- I couldn't figure out how to stop that from happening.
newtype Stack = Stack [Frame]
    deriving stock (Stack -> Stack -> Bool
(Stack -> Stack -> Bool) -> (Stack -> Stack -> Bool) -> Eq Stack
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stack -> Stack -> Bool
$c/= :: Stack -> Stack -> Bool
== :: Stack -> Stack -> Bool
$c== :: Stack -> Stack -> Bool
Eq, Eq Stack
Eq Stack
-> (Stack -> Stack -> Ordering)
-> (Stack -> Stack -> Bool)
-> (Stack -> Stack -> Bool)
-> (Stack -> Stack -> Bool)
-> (Stack -> Stack -> Bool)
-> (Stack -> Stack -> Stack)
-> (Stack -> Stack -> Stack)
-> Ord Stack
Stack -> Stack -> Bool
Stack -> Stack -> Ordering
Stack -> Stack -> Stack
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 :: Stack -> Stack -> Stack
$cmin :: Stack -> Stack -> Stack
max :: Stack -> Stack -> Stack
$cmax :: Stack -> Stack -> Stack
>= :: Stack -> Stack -> Bool
$c>= :: Stack -> Stack -> Bool
> :: Stack -> Stack -> Bool
$c> :: Stack -> Stack -> Bool
<= :: Stack -> Stack -> Bool
$c<= :: Stack -> Stack -> Bool
< :: Stack -> Stack -> Bool
$c< :: Stack -> Stack -> Bool
compare :: Stack -> Stack -> Ordering
$ccompare :: Stack -> Stack -> Ordering
Ord)
    deriving newtype (Stack -> ()
(Stack -> ()) -> NFData Stack
forall a. (a -> ()) -> NFData a
rnf :: Stack -> ()
$crnf :: Stack -> ()
DeepSeq.NFData, Get Stack
Putter Stack
Putter Stack -> Get Stack -> Serialize Stack
forall a. Putter a -> Get a -> Serialize a
get :: Get Stack
$cget :: Get Stack
put :: Putter Stack
$cput :: Putter Stack
Serialize.Serialize, [Stack] -> Encoding
[Stack] -> Value
Stack -> Encoding
Stack -> Value
(Stack -> Value)
-> (Stack -> Encoding)
-> ([Stack] -> Value)
-> ([Stack] -> Encoding)
-> ToJSON Stack
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Stack] -> Encoding
$ctoEncodingList :: [Stack] -> Encoding
toJSONList :: [Stack] -> Value
$ctoJSONList :: [Stack] -> Value
toEncoding :: Stack -> Encoding
$ctoEncoding :: Stack -> Encoding
toJSON :: Stack -> Value
$ctoJSON :: Stack -> Value
Aeson.ToJSON,
        Value -> Parser [Stack]
Value -> Parser Stack
(Value -> Parser Stack)
-> (Value -> Parser [Stack]) -> FromJSON Stack
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Stack]
$cparseJSONList :: Value -> Parser [Stack]
parseJSON :: Value -> Parser Stack
$cparseJSON :: Value -> Parser Stack
Aeson.FromJSON)

instance Show Stack where
    show :: Stack -> String
show Stack
stack = String
"Stack.from_outermost " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Frame] -> String
forall a. Show a => a -> String
show (Stack -> [Frame]
outermost Stack
stack)
instance Read.Read Stack where
    readPrec :: ReadPrec Stack
readPrec = do
        ReadPrec String
Pretty.readWord
        [Frame]
frames <- ReadPrec [Frame]
forall a. Read a => ReadPrec a
Read.readPrec
        Stack -> ReadPrec Stack
forall (m :: * -> *) a. Monad m => a -> m a
return ([Frame] -> Stack
from_outermost [Frame]
frames)

empty :: Stack
empty :: Stack
empty = [Frame] -> Stack
Stack []

length :: Stack -> Int
length :: Stack -> Int
length (Stack [Frame]
f) = [Frame] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Frame]
f

-- | Construct a Stack from frames starting with the outermost and ending with
-- the innermost.
from_outermost :: [Frame] -> Stack
from_outermost :: [Frame] -> Stack
from_outermost = [Frame] -> Stack
Stack ([Frame] -> Stack) -> ([Frame] -> [Frame]) -> [Frame] -> Stack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Frame] -> [Frame]
forall a. [a] -> [a]
reverse

-- | Construct a Stack from frames starting with the innermost and ending with
-- the outermost.
from_innermost :: [Frame] -> Stack
from_innermost :: [Frame] -> Stack
from_innermost = [Frame] -> Stack
Stack

-- | Make a Stack with a single block.
block :: BlockId -> Stack
block :: BlockId -> Stack
block = [Frame] -> Stack
from_innermost ([Frame] -> Stack) -> (BlockId -> [Frame]) -> BlockId -> Stack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Frame -> [Frame] -> [Frame]
forall a. a -> [a] -> [a]
:[]) (Frame -> [Frame]) -> (BlockId -> Frame) -> BlockId -> [Frame]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockId -> Frame
Block

-- | Make a Stack with a single call.
call :: Text -> Stack
call :: Text -> Stack
call = [Frame] -> Stack
from_innermost ([Frame] -> Stack) -> (Text -> [Frame]) -> Text -> Stack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Frame -> [Frame] -> [Frame]
forall a. a -> [a] -> [a]
:[]) (Frame -> [Frame]) -> (Text -> Frame) -> Text -> [Frame]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Frame
Call

-- | Add the frame to the innermost end of the stack.
add :: Frame -> Stack -> Stack
add :: Frame -> Stack -> Stack
add Frame
frame (Stack [Frame]
stack) = [Frame] -> Stack
Stack (Frame
frameFrame -> [Frame] -> [Frame]
forall a. a -> [a] -> [a]
:[Frame]
stack)

member :: Frame -> Stack -> Bool
member :: Frame -> Stack -> Bool
member Frame
frame (Stack [Frame]
s) = Frame
frame Frame -> [Frame] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Frame]
s

-- | The stack, starting with the outermost call and ending with the innermost.
-- All display should use this order.
outermost :: Stack -> [Frame]
outermost :: Stack -> [Frame]
outermost (Stack [Frame]
s) = [Frame] -> [Frame]
forall a. [a] -> [a]
reverse [Frame]
s

-- | The stack, starting with the innermost call and ending with the outermost.
innermost :: Stack -> [Frame]
innermost :: Stack -> [Frame]
innermost (Stack [Frame]
s) = [Frame]
s

block_of :: Frame -> Maybe BlockId
block_of :: Frame -> Maybe BlockId
block_of (Block BlockId
b) = BlockId -> Maybe BlockId
forall a. a -> Maybe a
Just BlockId
b
block_of Frame
_ = Maybe BlockId
forall a. Maybe a
Nothing

track_of :: Frame -> Maybe TrackId
track_of :: Frame -> Maybe TrackId
track_of (Track TrackId
t) = TrackId -> Maybe TrackId
forall a. a -> Maybe a
Just TrackId
t
track_of Frame
_ = Maybe TrackId
forall a. Maybe a
Nothing

region_of :: Frame -> Maybe (TrackTime, TrackTime)
region_of :: Frame -> Maybe (TrackTime, TrackTime)
region_of (Region TrackTime
s TrackTime
e) = (TrackTime, TrackTime) -> Maybe (TrackTime, TrackTime)
forall a. a -> Maybe a
Just (TrackTime
s, TrackTime
e)
region_of Frame
_ = Maybe (TrackTime, TrackTime)
forall a. Maybe a
Nothing

call_of :: Frame -> Maybe Text
call_of :: Frame -> Maybe Text
call_of (Call Text
s) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
call_of Frame
_ = Maybe Text
forall a. Maybe a
Nothing

-- | Walk up the stack to discover the innermost TrackId, then BlockId.
block_track_of :: Stack -> Maybe (BlockId, TrackId)
block_track_of :: Stack -> Maybe (BlockId, TrackId)
block_track_of = [Frame] -> Maybe (BlockId, TrackId)
find ([Frame] -> Maybe (BlockId, TrackId))
-> (Stack -> [Frame]) -> Stack -> Maybe (BlockId, TrackId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack -> [Frame]
innermost
    where
    find :: [Frame] -> Maybe (BlockId, TrackId)
find [Frame]
frames = do
        (TrackId
track_id, [Frame]
frames) <- (Frame -> Maybe TrackId) -> [Frame] -> Maybe (TrackId, [Frame])
forall a b. (a -> Maybe b) -> [a] -> Maybe (b, [a])
find_rest Frame -> Maybe TrackId
track_of [Frame]
frames
        (BlockId
block_id, [Frame]
_) <- (Frame -> Maybe BlockId) -> [Frame] -> Maybe (BlockId, [Frame])
forall a b. (a -> Maybe b) -> [a] -> Maybe (b, [a])
find_rest Frame -> Maybe BlockId
block_of [Frame]
frames
        (BlockId, TrackId) -> Maybe (BlockId, TrackId)
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockId
block_id, TrackId
track_id)

-- | Get each block and the tracks under it, starting from the innermost.
block_tracks_of :: Stack -> [(BlockId, [TrackId])]
block_tracks_of :: Stack -> [(BlockId, [TrackId])]
block_tracks_of = [TrackId] -> [Frame] -> [(BlockId, [TrackId])]
go [] ([Frame] -> [(BlockId, [TrackId])])
-> (Stack -> [Frame]) -> Stack -> [(BlockId, [TrackId])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack -> [Frame]
innermost
    where
    go :: [TrackId] -> [Frame] -> [(BlockId, [TrackId])]
go [TrackId]
track_ids (Frame
frame : [Frame]
frames) = case Frame
frame of
        Track TrackId
track_id -> [TrackId] -> [Frame] -> [(BlockId, [TrackId])]
go (TrackId
track_id TrackId -> [TrackId] -> [TrackId]
forall a. a -> [a] -> [a]
: [TrackId]
track_ids) [Frame]
frames
        Block BlockId
block_id -> (BlockId
block_id, [TrackId]
track_ids) (BlockId, [TrackId])
-> [(BlockId, [TrackId])] -> [(BlockId, [TrackId])]
forall a. a -> [a] -> [a]
: [TrackId] -> [Frame] -> [(BlockId, [TrackId])]
go [] [Frame]
frames
        Frame
_ -> [TrackId] -> [Frame] -> [(BlockId, [TrackId])]
go [TrackId]
track_ids [Frame]
frames
    go [TrackId]
_ [] = []

-- | Walk up the stack to discover the innermost Region, TrackId, then BlockId.
block_track_region_of :: Stack
    -> Maybe (BlockId, TrackId, (TrackTime, TrackTime))
block_track_region_of :: Stack -> Maybe (BlockId, TrackId, (TrackTime, TrackTime))
block_track_region_of = [Frame] -> Maybe (BlockId, TrackId, (TrackTime, TrackTime))
find ([Frame] -> Maybe (BlockId, TrackId, (TrackTime, TrackTime)))
-> (Stack -> [Frame])
-> Stack
-> Maybe (BlockId, TrackId, (TrackTime, TrackTime))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack -> [Frame]
innermost
    where
    find :: [Frame] -> Maybe (BlockId, TrackId, (TrackTime, TrackTime))
find [Frame]
frames = do
        ((TrackTime, TrackTime)
region, [Frame]
frames) <- (Frame -> Maybe (TrackTime, TrackTime))
-> [Frame] -> Maybe ((TrackTime, TrackTime), [Frame])
forall a b. (a -> Maybe b) -> [a] -> Maybe (b, [a])
find_rest Frame -> Maybe (TrackTime, TrackTime)
region_of [Frame]
frames
        (TrackId
track_id, [Frame]
frames) <- (Frame -> Maybe TrackId) -> [Frame] -> Maybe (TrackId, [Frame])
forall a b. (a -> Maybe b) -> [a] -> Maybe (b, [a])
find_rest Frame -> Maybe TrackId
track_of [Frame]
frames
        (BlockId
block_id, [Frame]
_) <- (Frame -> Maybe BlockId) -> [Frame] -> Maybe (BlockId, [Frame])
forall a b. (a -> Maybe b) -> [a] -> Maybe (b, [a])
find_rest Frame -> Maybe BlockId
block_of [Frame]
frames
        (BlockId, TrackId, (TrackTime, TrackTime))
-> Maybe (BlockId, TrackId, (TrackTime, TrackTime))
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockId
block_id, TrackId
track_id, (TrackTime, TrackTime)
region)

-- | Find a value, and return the rest of the list.
find_rest :: (a -> Maybe b) -> [a] -> Maybe (b, [a])
find_rest :: forall a b. (a -> Maybe b) -> [a] -> Maybe (b, [a])
find_rest a -> Maybe b
f = [a] -> Maybe (b, [a])
go
    where
    go :: [a] -> Maybe (b, [a])
go (a
x:[a]
xs) = Maybe (b, [a])
-> (b -> Maybe (b, [a])) -> Maybe b -> Maybe (b, [a])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([a] -> Maybe (b, [a])
go [a]
xs) (\b
y -> (b, [a]) -> Maybe (b, [a])
forall a. a -> Maybe a
Just (b
y, [a]
xs)) (a -> Maybe b
f a
x)
    go [] = Maybe (b, [a])
forall a. Maybe a
Nothing

-- | Nothing is a wildcard, and matches anything, but if a field is set then it
-- only matches frames where the corresponding field is set, and is equal (or
-- overlaps in the case of range).
type Pattern =
    (Maybe BlockId, Maybe (Set TrackId), Maybe (TrackTime, TrackTime))

match :: Pattern -> Stack -> Bool
match :: Pattern -> Stack -> Bool
match Pattern
pattern = (UiFrame -> Bool) -> [UiFrame] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Pattern -> UiFrame -> Bool
ui_match Pattern
pattern) ([UiFrame] -> Bool) -> (Stack -> [UiFrame]) -> Stack -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack -> [UiFrame]
to_ui

-- ** frames

data Frame =
    Block !BlockId
    | Track !TrackId
    | Region !TrackTime !TrackTime
    | Call !Text
    | Serial !Serial
    deriving stock (Frame -> Frame -> Bool
(Frame -> Frame -> Bool) -> (Frame -> Frame -> Bool) -> Eq Frame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Frame -> Frame -> Bool
$c/= :: Frame -> Frame -> Bool
== :: Frame -> Frame -> Bool
$c== :: Frame -> Frame -> Bool
Eq, Eq Frame
Eq Frame
-> (Frame -> Frame -> Ordering)
-> (Frame -> Frame -> Bool)
-> (Frame -> Frame -> Bool)
-> (Frame -> Frame -> Bool)
-> (Frame -> Frame -> Bool)
-> (Frame -> Frame -> Frame)
-> (Frame -> Frame -> Frame)
-> Ord Frame
Frame -> Frame -> Bool
Frame -> Frame -> Ordering
Frame -> Frame -> Frame
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 :: Frame -> Frame -> Frame
$cmin :: Frame -> Frame -> Frame
max :: Frame -> Frame -> Frame
$cmax :: Frame -> Frame -> Frame
>= :: Frame -> Frame -> Bool
$c>= :: Frame -> Frame -> Bool
> :: Frame -> Frame -> Bool
$c> :: Frame -> Frame -> Bool
<= :: Frame -> Frame -> Bool
$c<= :: Frame -> Frame -> Bool
< :: Frame -> Frame -> Bool
$c< :: Frame -> Frame -> Bool
compare :: Frame -> Frame -> Ordering
$ccompare :: Frame -> Frame -> Ordering
Ord, ReadPrec [Frame]
ReadPrec Frame
Int -> ReadS Frame
ReadS [Frame]
(Int -> ReadS Frame)
-> ReadS [Frame]
-> ReadPrec Frame
-> ReadPrec [Frame]
-> Read Frame
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Frame]
$creadListPrec :: ReadPrec [Frame]
readPrec :: ReadPrec Frame
$creadPrec :: ReadPrec Frame
readList :: ReadS [Frame]
$creadList :: ReadS [Frame]
readsPrec :: Int -> ReadS Frame
$creadsPrec :: Int -> ReadS Frame
Read, Int -> Frame -> ShowS
[Frame] -> ShowS
Frame -> String
(Int -> Frame -> ShowS)
-> (Frame -> String) -> ([Frame] -> ShowS) -> Show Frame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Frame] -> ShowS
$cshowList :: [Frame] -> ShowS
show :: Frame -> String
$cshow :: Frame -> String
showsPrec :: Int -> Frame -> ShowS
$cshowsPrec :: Int -> Frame -> ShowS
Show)

-- | The 'Stack' is used as a unique key for a unique call of a generator.
-- For instance, the cache uses it to cache generator output, and the random
-- mechanism uses it to permute 'Derive.EnvKey.seed'.  Since a single track
-- event may call multiple generators internally, each one is given a unique
-- serial number.
type Serial = Int

instance DeepSeq.NFData Frame where
    rnf :: Frame -> ()
rnf Frame
f = Frame
f Frame -> () -> ()
`seq` ()

instance Pretty Stack where
    format :: Stack -> Doc
format = [Frame] -> Doc
forall a. Pretty a => [a] -> Doc
Pretty.formatList ([Frame] -> Doc) -> (Stack -> [Frame]) -> Stack -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack -> [Frame]
outermost

instance Pretty Frame where
    pretty :: Frame -> Text
pretty (Block BlockId
bid) = BlockId -> Text
forall a. Show a => a -> Text
showt BlockId
bid
    pretty (Track TrackId
tid) = TrackId -> Text
forall a. Show a => a -> Text
showt TrackId
tid
    pretty (Region TrackTime
s TrackTime
e) = TrackTime -> Text
forall a. Pretty a => a -> Text
pretty TrackTime
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TrackTime -> Text
forall a. Pretty a => a -> Text
pretty TrackTime
e
    pretty (Call Text
call) = Text
call
    pretty (Serial Int
n) = Int -> Text
forall a. Pretty a => a -> Text
pretty Int
n

instance Serialize.Serialize Frame where
    put :: Putter Frame
put Frame
frame = case Frame
frame of
        Block BlockId
bid -> Word8 -> Put
Serialize.put_tag Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter BlockId
forall a. Serialize a => Putter a
Serialize.put BlockId
bid
        Track TrackId
tid -> Word8 -> Put
Serialize.put_tag Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter TrackId
forall a. Serialize a => Putter a
Serialize.put TrackId
tid
        Region TrackTime
s TrackTime
e -> Word8 -> Put
Serialize.put_tag Word8
2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter TrackTime
forall a. Serialize a => Putter a
Serialize.put TrackTime
s Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter TrackTime
forall a. Serialize a => Putter a
Serialize.put TrackTime
e
        Call Text
s -> Word8 -> Put
Serialize.put_tag Word8
4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Text
forall a. Serialize a => Putter a
Serialize.put Text
s
        Serial Int
n -> Word8 -> Put
Serialize.put_tag Word8
5 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Int
forall a. Serialize a => Putter a
Serialize.put Int
n
    get :: Get Frame
get = do
        Word8
tag <- Get Word8
Serialize.get_tag
        case Word8
tag of
            Word8
0 -> do
                BlockId
bid :: BlockId <- Get BlockId
forall a. Serialize a => Get a
Serialize.get
                Frame -> Get Frame
forall (m :: * -> *) a. Monad m => a -> m a
return (Frame -> Get Frame) -> Frame -> Get Frame
forall a b. (a -> b) -> a -> b
$ BlockId -> Frame
Block BlockId
bid
            Word8
1 -> do
                TrackId
tid :: TrackId <- Get TrackId
forall a. Serialize a => Get a
Serialize.get
                Frame -> Get Frame
forall (m :: * -> *) a. Monad m => a -> m a
return (Frame -> Get Frame) -> Frame -> Get Frame
forall a b. (a -> b) -> a -> b
$ TrackId -> Frame
Track TrackId
tid
            Word8
2 -> do
                TrackTime
s :: TrackTime <- Get TrackTime
forall a. Serialize a => Get a
Serialize.get
                TrackTime
e :: TrackTime <- Get TrackTime
forall a. Serialize a => Get a
Serialize.get
                Frame -> Get Frame
forall (m :: * -> *) a. Monad m => a -> m a
return (Frame -> Get Frame) -> Frame -> Get Frame
forall a b. (a -> b) -> a -> b
$ TrackTime -> TrackTime -> Frame
Region TrackTime
s TrackTime
e
            Word8
3 -> do
                String
s :: String <- Get String
forall a. Serialize a => Get a
Serialize.get
                Frame -> Get Frame
forall (m :: * -> *) a. Monad m => a -> m a
return (Frame -> Get Frame) -> Frame -> Get Frame
forall a b. (a -> b) -> a -> b
$ Text -> Frame
Call (String -> Text
txt String
s)
            Word8
4 -> do
                Text
s :: Text <- Get Text
forall a. Serialize a => Get a
Serialize.get
                Frame -> Get Frame
forall (m :: * -> *) a. Monad m => a -> m a
return (Frame -> Get Frame) -> Frame -> Get Frame
forall a b. (a -> b) -> a -> b
$ Text -> Frame
Call Text
s
            Word8
5 -> do
                Int
n :: Int <- Get Int
forall a. Serialize a => Get a
Serialize.get
                Frame -> Get Frame
forall (m :: * -> *) a. Monad m => a -> m a
return (Frame -> Get Frame) -> Frame -> Get Frame
forall a b. (a -> b) -> a -> b
$ Int -> Frame
Serial Int
n
            Word8
_ -> String -> Word8 -> Get Frame
forall a. String -> Word8 -> Get a
Serialize.bad_tag String
"Stack.Frame" Word8
tag

instance Seed.Seed Frame where
    to_seed :: Int -> Frame -> Int
to_seed Int
n = \case
        Block BlockId
block_id -> Int
n Int -> BlockId -> Int
forall a. Seed a => Int -> a -> Int
Seed.& BlockId
block_id
        Track TrackId
track_id -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> TrackId -> Int
forall a. Seed a => Int -> a -> Int
Seed.& TrackId
track_id
        Region TrackTime
s TrackTime
e -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> TrackTime -> Int
forall a. Seed a => Int -> a -> Int
Seed.& TrackTime
s Int -> TrackTime -> Int
forall a. Seed a => Int -> a -> Int
Seed.& TrackTime
e
        Call Text
call -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Text -> Int
forall a. Seed a => Int -> a -> Int
Seed.& Text
call
        Serial Int
i -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Seed a => Int -> a -> Int
Seed.& Int
i

instance Aeson.ToJSON Frame where
    toJSON :: Frame -> Value
toJSON Frame
frame = Array -> Value
Aeson.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ case Frame
frame of
            Block BlockId
block_id -> Text -> Value -> Array
tagged Text
"Block" (Value -> Array) -> Value -> Array
forall a b. (a -> b) -> a -> b
$
                Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ BlockId -> Text
forall a. Ident a => a -> Text
Id.ident_text BlockId
block_id
            Track TrackId
track_id -> Text -> Value -> Array
tagged Text
"Track" (Value -> Array) -> Value -> Array
forall a b. (a -> b) -> a -> b
$
                Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ TrackId -> Text
forall a. Ident a => a -> Text
Id.ident_text TrackId
track_id
            Region TrackTime
s TrackTime
e -> Text -> Value -> Array
tagged Text
"Region" (Value -> Array) -> Value -> Array
forall a b. (a -> b) -> a -> b
$
                (Double, Double) -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (TrackTime -> Double
ScoreTime.to_double TrackTime
s, TrackTime -> Double
ScoreTime.to_double TrackTime
e)
            Call Text
text -> Text -> Value -> Array
tagged Text
"Call" (Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Text
text)
            Serial Int
n -> Text -> Value -> Array
tagged Text
"Serial" (Int -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Int
n)
        where tagged :: Text -> Value -> Array
tagged Text
name Value
val = [Value] -> Array
forall a. [a] -> Vector a
Vector.fromList [Text -> Value
Aeson.String Text
name, Value
val]

instance Aeson.FromJSON Frame where
    parseJSON :: Value -> Parser Frame
parseJSON (Aeson.Array Array
a) = case Array -> [Value]
forall a. Vector a -> [a]
Vector.toList Array
a of
        [Aeson.String Text
tag, Value
val]
            | Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Block" ->
                BlockId -> Frame
Block (BlockId -> Frame) -> (Text -> BlockId) -> Text -> Frame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> BlockId
Id.BlockId (Id -> BlockId) -> (Text -> Id) -> Text -> BlockId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Id
Id.read_id (Text -> Frame) -> Parser Text -> Parser Frame
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
val
            | Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Track" ->
                TrackId -> Frame
Track (TrackId -> Frame) -> (Text -> TrackId) -> Text -> Frame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> TrackId
Id.TrackId (Id -> TrackId) -> (Text -> Id) -> Text -> TrackId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Id
Id.read_id (Text -> Frame) -> Parser Text -> Parser Frame
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
val
            | Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Region" -> (TrackTime -> TrackTime -> Frame)
-> (TrackTime, TrackTime) -> Frame
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TrackTime -> TrackTime -> Frame
Region
                ((TrackTime, TrackTime) -> Frame)
-> ((Double, Double) -> (TrackTime, TrackTime))
-> (Double, Double)
-> Frame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> TrackTime)
-> (Double -> TrackTime)
-> (Double, Double)
-> (TrackTime, TrackTime)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Double -> TrackTime
ScoreTime.from_double Double -> TrackTime
ScoreTime.from_double ((Double, Double) -> Frame)
-> Parser (Double, Double) -> Parser Frame
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                Value -> Parser (Double, Double)
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
val
            | Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Call" -> Text -> Frame
Call (Text -> Frame) -> Parser Text -> Parser Frame
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
val
            | Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Serial" -> Int -> Frame
Serial (Int -> Frame) -> Parser Int -> Parser Frame
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
val
            | Bool
otherwise -> String -> Parser Frame
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Frame) -> String -> Parser Frame
forall a b. (a -> b) -> a -> b
$ String
"unknown tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
untxt Text
tag
        [Value]
_ -> String -> Parser Frame
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting two element array"
    parseJSON Value
_ = String -> Parser Frame
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting array"

format_ui :: Stack -> Pretty.Doc
format_ui :: Stack -> Doc
format_ui = [Text] -> Doc
Pretty.textList ([Text] -> Doc) -> (Stack -> [Text]) -> Stack -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UiFrame -> Text) -> [UiFrame] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map UiFrame -> Text
unparse_ui_frame ([UiFrame] -> [Text]) -> (Stack -> [UiFrame]) -> Stack -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack -> [UiFrame]
to_ui

pretty_ui :: Stack -> Text
pretty_ui :: Stack -> Text
pretty_ui = Text -> [Text] -> Text
Text.intercalate Text
" / " ([Text] -> Text) -> (Stack -> [Text]) -> Stack -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UiFrame -> Text) -> [UiFrame] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map UiFrame -> Text
unparse_ui_frame ([UiFrame] -> [Text]) -> (Stack -> [UiFrame]) -> Stack -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack -> [UiFrame]
to_ui

pretty_ui_ :: Stack -> Text
pretty_ui_ :: Stack -> Text
pretty_ui_ = Text -> [Text] -> Text
Text.intercalate Text
" / " ([Text] -> Text) -> (Stack -> [Text]) -> Stack -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UiFrame -> Text) -> [UiFrame] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map UiFrame -> Text
unparse_ui_frame_ ([UiFrame] -> [Text]) -> (Stack -> [UiFrame]) -> Stack -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack -> [UiFrame]
to_ui

-- | Loggable msg with the last position of the stack.
pretty_ui_inner :: Stack -> Maybe Text
pretty_ui_inner :: Stack -> Maybe Text
pretty_ui_inner = (UiFrame -> Text) -> Maybe UiFrame -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UiFrame -> Text
log_ui_frame (Maybe UiFrame -> Maybe Text)
-> (Stack -> Maybe UiFrame) -> Stack -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UiFrame] -> Maybe UiFrame
forall a. [a] -> Maybe a
Seq.head ([UiFrame] -> Maybe UiFrame)
-> (Stack -> [UiFrame]) -> Stack -> Maybe UiFrame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack -> [UiFrame]
to_ui_innermost

-- | Format a UiFrame for logging.  This means it wraps it in @{s "..."}@,
-- which causes logview to make it clickable, which will highlight the stack
-- location.
log_ui_frame :: UiFrame -> Text
log_ui_frame :: UiFrame -> Text
log_ui_frame UiFrame
frame = Text
"{s " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
showt (UiFrame -> Text
unparse_ui_frame UiFrame
frame) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"

-- * more specialized utils

-- | Get the Regions associated with a track in a given stack.  It's a little
-- tricky because track level calls will go in between the track and the
-- region, e.g. [track, call, call, region].
track_regions :: Stack -> TrackId -> [Ranges.Ranges TrackTime]
track_regions :: Stack -> TrackId -> [Ranges TrackTime]
track_regions Stack
stack TrackId
track_id =
    [TrackTime -> TrackTime -> Ranges TrackTime
forall n. n -> n -> Ranges n
Ranges.range TrackTime
s TrackTime
e | Frame
_ : [Frame]
rest <- [[Frame]]
groups, (TrackTime
s, TrackTime
e) <- [Frame] -> [(TrackTime, TrackTime)]
get_region [Frame]
rest ]
    where
    groups :: [[Frame]]
groups = (Frame -> Bool) -> [Frame] -> [[Frame]]
forall a. (a -> Bool) -> [a] -> [[a]]
Seq.split_before (Frame -> Frame -> Bool
forall a. Eq a => a -> a -> Bool
== TrackId -> Frame
Track TrackId
track_id) (Stack -> [Frame]
outermost Stack
stack)
    get_region :: [Frame] -> [(TrackTime, TrackTime)]
get_region [Frame]
frames = case (Frame -> Bool) -> [Frame] -> [Frame]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Frame -> Bool
is_call [Frame]
frames of
        Region TrackTime
s TrackTime
e : [Frame]
_ -> [(TrackTime
s, TrackTime
e)]
        [Frame]
_ -> []
    is_call :: Frame -> Bool
is_call (Call {}) = Bool
True
    is_call Frame
_ = Bool
False
    -- find [track, call*, region] where the region overlaps

-- * ui

ui_match :: Pattern -> UiFrame -> Bool
ui_match :: Pattern -> UiFrame -> Bool
ui_match (Maybe BlockId
bid_pattern, Maybe (Set TrackId)
tids_pattern, Maybe (TrackTime, TrackTime)
range_pattern) (Maybe BlockId
bid, Maybe TrackId
tid, Maybe (TrackTime, TrackTime)
range) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
    [ Bool -> (BlockId -> Bool) -> Maybe BlockId -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((Maybe BlockId -> Maybe BlockId -> Bool
forall a. Eq a => a -> a -> Bool
==Maybe BlockId
bid) (Maybe BlockId -> Bool)
-> (BlockId -> Maybe BlockId) -> BlockId -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockId -> Maybe BlockId
forall a. a -> Maybe a
Just) Maybe BlockId
bid_pattern
    , case (Maybe (Set TrackId)
tids_pattern, Maybe TrackId
tid) of
        (Just Set TrackId
tids, Just TrackId
tid) -> TrackId -> Set TrackId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TrackId
tid Set TrackId
tids
        (Maybe (Set TrackId)
Nothing, Maybe TrackId
_) -> Bool
True
        (Maybe (Set TrackId)
_, Maybe TrackId
Nothing) -> Bool
False
    , Bool
-> ((TrackTime, TrackTime) -> Bool)
-> Maybe (TrackTime, TrackTime)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (TrackTime, TrackTime) -> Bool
overlaps Maybe (TrackTime, TrackTime)
range_pattern
    ]
    where
    overlaps :: (TrackTime, TrackTime) -> Bool
overlaps (TrackTime
s, TrackTime
e) = case Maybe (TrackTime, TrackTime)
range of
        Maybe (TrackTime, TrackTime)
Nothing -> Bool
False
        Just (TrackTime
start, TrackTime
end) -> Bool -> Bool
not (TrackTime
end TrackTime -> TrackTime -> Bool
forall a. Ord a => a -> a -> Bool
<= TrackTime
s Bool -> Bool -> Bool
|| TrackTime
start TrackTime -> TrackTime -> Bool
forall a. Ord a => a -> a -> Bool
>= TrackTime
e)

-- | This is an abbreviation of the stack that only has elements that are
-- visible in the UI.
--
-- @(block_id, track_id, (event_start, event_end))@
type UiFrame = (Maybe BlockId, Maybe TrackId, Maybe (TrackTime, TrackTime))

-- | UiFrames are returned in outermost to innermost order.
to_ui :: Stack -> [UiFrame]
to_ui :: Stack -> [UiFrame]
to_ui = [UiFrame] -> [UiFrame]
forall a. [a] -> [a]
reverse ([UiFrame] -> [UiFrame])
-> (Stack -> [UiFrame]) -> Stack -> [UiFrame]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack -> [UiFrame]
to_ui_innermost

to_ui_innermost :: Stack -> [UiFrame]
to_ui_innermost :: Stack -> [UiFrame]
to_ui_innermost = (Frame -> [UiFrame] -> [UiFrame])
-> [UiFrame] -> [Frame] -> [UiFrame]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Frame -> [UiFrame] -> [UiFrame]
f [] ([Frame] -> [UiFrame]) -> (Stack -> [Frame]) -> Stack -> [UiFrame]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack -> [Frame]
innermost
    where
    f :: Frame -> [UiFrame] -> [UiFrame]
f (Block BlockId
bid) [UiFrame]
accum = (BlockId -> Maybe BlockId
forall a. a -> Maybe a
Just BlockId
bid, Maybe TrackId
forall a. Maybe a
Nothing, Maybe (TrackTime, TrackTime)
forall a. Maybe a
Nothing) UiFrame -> [UiFrame] -> [UiFrame]
forall a. a -> [a] -> [a]
: [UiFrame]
accum
    f (Track TrackId
tid) ((Maybe BlockId
bid, Maybe TrackId
_, Maybe (TrackTime, TrackTime)
_) : [UiFrame]
rest) = (Maybe BlockId
bid, TrackId -> Maybe TrackId
forall a. a -> Maybe a
Just TrackId
tid, Maybe (TrackTime, TrackTime)
forall a. Maybe a
Nothing) UiFrame -> [UiFrame] -> [UiFrame]
forall a. a -> [a] -> [a]
: [UiFrame]
rest
    f (Region TrackTime
s TrackTime
e) ((Maybe BlockId
bid, tid :: Maybe TrackId
tid@(Just TrackId
_), Maybe (TrackTime, TrackTime)
_) : [UiFrame]
rest) =
        (Maybe BlockId
bid, Maybe TrackId
tid, (TrackTime, TrackTime) -> Maybe (TrackTime, TrackTime)
forall a. a -> Maybe a
Just (TrackTime
s, TrackTime
e)) UiFrame -> [UiFrame] -> [UiFrame]
forall a. a -> [a] -> [a]
: [UiFrame]
rest
    f Frame
_ [UiFrame]
accum = [UiFrame]
accum

-- | These functions are used by LogView and Cmd.Repl.*, but are here since
-- both places import this module.  Examples:
--
-- > "untitled/b0 untitled/b0.t2 0-.25"
-- > "untitled/b0 foo/bar *"
-- > "untitled/b0 * *"
unparse_ui_frame :: UiFrame -> Text
unparse_ui_frame :: UiFrame -> Text
unparse_ui_frame (Maybe BlockId
maybe_bid, Maybe TrackId
maybe_tid, Maybe (TrackTime, TrackTime)
maybe_range) =
    Text -> [Text] -> Text
Text.intercalate Text
" " [Text
bid_s, Text
tid_s, Text
range_s]
    where
    bid_s :: Text
bid_s = Text -> (BlockId -> Text) -> Maybe BlockId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"*" (Id -> Text
Id.show_id (Id -> Text) -> (BlockId -> Id) -> BlockId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockId -> Id
forall a. Ident a => a -> Id
Id.unpack_id) Maybe BlockId
maybe_bid
    tid_s :: Text
tid_s = Text -> (TrackId -> Text) -> Maybe TrackId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"*" (Id -> Text
Id.show_id (Id -> Text) -> (TrackId -> Id) -> TrackId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackId -> Id
forall a. Ident a => a -> Id
Id.unpack_id) Maybe TrackId
maybe_tid
    range_s :: Text
range_s = Text
-> ((TrackTime, TrackTime) -> Text)
-> Maybe (TrackTime, TrackTime)
-> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"*"
        (\(TrackTime
from, TrackTime
to) -> TrackTime -> Text
float TrackTime
from Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TrackTime -> Text
float TrackTime
to) Maybe (TrackTime, TrackTime)
maybe_range
    float :: TrackTime -> Text
float = Int -> Double -> Text
forall a. RealFloat a => Int -> a -> Text
Num.showFloat Int
2 (Double -> Text) -> (TrackTime -> Double) -> TrackTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackTime -> Double
ScoreTime.to_double

-- | This is like 'unparse_ui_frame' except it omits the namespaces for a less
-- cluttered but potentially ambiguous output.
unparse_ui_frame_ :: UiFrame -> Text
unparse_ui_frame_ :: UiFrame -> Text
unparse_ui_frame_ (Maybe BlockId
maybe_bid, Maybe TrackId
maybe_tid, Maybe (TrackTime, TrackTime)
maybe_range) =
    [Text] -> Text
Text.unwords [Text
bid_s, Text
tid_s, Text
range_s]
    where
    bid_s :: Text
bid_s = Text -> (BlockId -> Text) -> Maybe BlockId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"*" BlockId -> Text
forall a. Ident a => a -> Text
Id.ident_name Maybe BlockId
maybe_bid
    tid_s :: Text
tid_s = Text -> (TrackId -> Text) -> Maybe TrackId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"*" TrackId -> Text
forall a. Ident a => a -> Text
Id.ident_name Maybe TrackId
maybe_tid
    range_s :: Text
range_s = Text
-> ((TrackTime, TrackTime) -> Text)
-> Maybe (TrackTime, TrackTime)
-> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"*"
        (\(TrackTime
from, TrackTime
to) -> TrackTime -> Text
float TrackTime
from Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TrackTime -> Text
float TrackTime
to) Maybe (TrackTime, TrackTime)
maybe_range
    float :: TrackTime -> Text
float = Int -> Double -> Text
forall a. RealFloat a => Int -> a -> Text
Num.showFloat Int
2 (Double -> Text) -> (TrackTime -> Double) -> TrackTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackTime -> Double
ScoreTime.to_double

parse_ui_frame :: String -> Maybe UiFrame
parse_ui_frame :: String -> Maybe UiFrame
parse_ui_frame = Parser UiFrame -> String -> Maybe UiFrame
forall a. Parser a -> String -> Maybe a
ParseText.maybe_parse_string (Parser UiFrame -> String -> Maybe UiFrame)
-> Parser UiFrame -> String -> Maybe UiFrame
forall a b. (a -> b) -> a -> b
$ do
    Maybe Text
bid <- Parser Text Text -> Parser Text (Maybe Text)
forall {a}. Parser Text a -> Parser Text (Maybe a)
optional (Parser Text Text -> Parser Text (Maybe Text))
-> Parser Text Text -> Parser Text (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Parser Text Text -> Parser Text Text
forall a. Parser a -> Parser a
ParseText.lexeme Parser Text Text
ParseText.p_word
    Maybe Text
tid <- Parser Text Text -> Parser Text (Maybe Text)
forall {a}. Parser Text a -> Parser Text (Maybe a)
optional (Parser Text Text -> Parser Text (Maybe Text))
-> Parser Text Text -> Parser Text (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Parser Text Text -> Parser Text Text
forall a. Parser a -> Parser a
ParseText.lexeme Parser Text Text
ParseText.p_word
    Maybe (TrackTime, TrackTime)
range <- Parser Text (TrackTime, TrackTime)
-> Parser Text (Maybe (TrackTime, TrackTime))
forall {a}. Parser Text a -> Parser Text (Maybe a)
optional (Parser Text (TrackTime, TrackTime)
 -> Parser Text (Maybe (TrackTime, TrackTime)))
-> Parser Text (TrackTime, TrackTime)
-> Parser Text (Maybe (TrackTime, TrackTime))
forall a b. (a -> b) -> a -> b
$ do
        Double
from <- Parser Double
ParseText.p_float
        Char -> Parser Char
A.char Char
'-'
        Double
to <- Parser Double
ParseText.p_float
        (TrackTime, TrackTime) -> Parser Text (TrackTime, TrackTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> TrackTime
ScoreTime.from_double Double
from, Double -> TrackTime
ScoreTime.from_double Double
to)
    UiFrame -> Parser UiFrame
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( Id -> BlockId
Id.BlockId (Id -> BlockId) -> (Text -> Id) -> Text -> BlockId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Id
Id.read_id (Text -> BlockId) -> Maybe Text -> Maybe BlockId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
bid
        , Id -> TrackId
Id.TrackId (Id -> TrackId) -> (Text -> Id) -> Text -> TrackId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Id
Id.read_id (Text -> TrackId) -> Maybe Text -> Maybe TrackId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
tid
        , Maybe (TrackTime, TrackTime)
range
        )
    where
    optional :: Parser Text a -> Parser Text (Maybe a)
optional Parser Text a
p = (Char -> Parser Char
A.char Char
'*' Parser Char -> Parser Text () -> Parser Text ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text ()
A.skipSpace Parser Text () -> Parser Text (Maybe a) -> Parser Text (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> Parser Text (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)
        Parser Text (Maybe a)
-> Parser Text (Maybe a) -> Parser Text (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> Maybe a) -> Parser Text a -> Parser Text (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just Parser Text a
p