{-# 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
, track_regions
, 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
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
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
from_innermost :: [Frame] -> Stack
from_innermost :: [Frame] -> Stack
from_innermost = [Frame] -> Stack
Stack
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
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 :: 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
outermost :: Stack -> [Frame]
outermost :: Stack -> [Frame]
outermost (Stack [Frame]
s) = [Frame] -> [Frame]
forall a. [a] -> [a]
reverse [Frame]
s
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
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)
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]
_ [] = []
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_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
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
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)
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
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
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
"}"
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
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)
type UiFrame = (Maybe BlockId, Maybe TrackId, Maybe (TrackTime, TrackTime))
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
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
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