-- Copyright 2016 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

-- | Utilities for solkattu.  This re-exports "Solkattu.Db" so I can
-- find pre-defined korvais.
--
-- E.g.:
-- > return $ LSol.search $ LSol.hasInstrument "kendang_tunggal"
-- > return $ LSol.search $ LSol.aroundDate (LSol.date 2017 7 10) 10
-- > 59: .... etc
-- > LSol.insert_k1 True 1 59 0
module Cmd.Repl.LSol (
    module Cmd.Repl.LSol
    , module Solkattu.Db
) where
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Text as Text

import qualified Util.Lists as Lists
import qualified Util.ParseText as ParseText
import qualified App.ReplProtocol as ReplProtocol
import qualified Cmd.Cmd as Cmd
import qualified Cmd.Create as Create
import qualified Cmd.Integrate as Integrate
import qualified Cmd.Integrate.Manual as Manual
import qualified Cmd.ModifyNotes as ModifyNotes
import qualified Cmd.Selection as Selection

import qualified Derive.Expr as Expr
import qualified Derive.ScoreT as ScoreT
import qualified Derive.ShowVal as ShowVal
import qualified Derive.Stack as Stack

import qualified Perform.Pitch as Pitch
import qualified Solkattu.Db as Db
import           Solkattu.Db hiding (realize, search, searchp)
import qualified Solkattu.Format.Format as Format
import qualified Solkattu.Instrument.ToScore as ToScore
import qualified Solkattu.Korvai as Korvai
import qualified Solkattu.Metadata as Metadata
import qualified Solkattu.Realize as Realize
import qualified Solkattu.S as S
import qualified Solkattu.Solkattu as Solkattu

import qualified Ui.Block as Block
import qualified Ui.Event as Event
import qualified Ui.Events as Events
import qualified Ui.Ui as Ui

import           Global
import           Types


type ScoreIndex = Int
type SectionIndex = Int

-- * search

search :: Monad m => [Korvai.Score -> Bool] -> m Text
search :: forall (m :: * -> *). Monad m => [Score -> Bool] -> m Text
search = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SectionIndex, Score)] -> Text
Db.formats forall b c a. (b -> c) -> (a -> b) -> a -> c
. Select -> [Score -> Bool] -> [(SectionIndex, Score)]
Db.searchAll forall a. a -> a
id

-- * realize

insert_m :: Cmd.M m => Bool -> TrackTime -> ScoreIndex -> SectionIndex -> m ()
insert_m :: forall (m :: * -> *).
M m =>
Bool -> TrackTime -> SectionIndex -> SectionIndex -> m ()
insert_m = forall (m :: * -> *) stroke.
(M m, Notation stroke, ToExpr (Stroke stroke), Ord stroke) =>
Instrument stroke
-> Bool -> TrackTime -> SectionIndex -> SectionIndex -> m ()
insert Instrument Stroke
Korvai.IMridangam

insert_k1 :: Cmd.M m => Bool -> TrackTime -> ScoreIndex -> SectionIndex -> m ()
insert_k1 :: forall (m :: * -> *).
M m =>
Bool -> TrackTime -> SectionIndex -> SectionIndex -> m ()
insert_k1 = forall (m :: * -> *) stroke.
(M m, Notation stroke, ToExpr (Stroke stroke), Ord stroke) =>
Instrument stroke
-> Bool -> TrackTime -> SectionIndex -> SectionIndex -> m ()
insert Instrument Stroke
Korvai.IKendangTunggal

insert_r :: Cmd.M m => Bool -> TrackTime -> ScoreIndex -> SectionIndex -> m ()
insert_r :: forall (m :: * -> *).
M m =>
Bool -> TrackTime -> SectionIndex -> SectionIndex -> m ()
insert_r = forall (m :: * -> *) stroke.
(M m, Notation stroke, ToExpr (Stroke stroke), Ord stroke) =>
Instrument stroke
-> Bool -> TrackTime -> SectionIndex -> SectionIndex -> m ()
insert Instrument Stroke
Korvai.IReyong

insert_sargam :: Cmd.M m => TrackTime -> ScoreIndex -> SectionIndex -> m ()
insert_sargam :: forall (m :: * -> *).
M m =>
TrackTime -> SectionIndex -> SectionIndex -> m ()
insert_sargam = forall (m :: * -> *) stroke.
(M m, Notation stroke, ToExpr (Stroke stroke), Ord stroke) =>
Instrument stroke
-> Bool -> TrackTime -> SectionIndex -> SectionIndex -> m ()
insert Instrument Stroke
Korvai.ISargam Bool
True

-- | Insert the korvai at the selection.
-- TODO implement ModifyNotes.replace_tracks to clear existing notes first
insert :: (Cmd.M m, Solkattu.Notation stroke,
        Expr.ToExpr (Realize.Stroke stroke), Ord stroke)
     => Korvai.Instrument stroke -> Bool -> TrackTime -> ScoreIndex
    -> SectionIndex -> m ()
insert :: forall (m :: * -> *) stroke.
(M m, Notation stroke, ToExpr (Stroke stroke), Ord stroke) =>
Instrument stroke
-> Bool -> TrackTime -> SectionIndex -> SectionIndex -> m ()
insert Instrument stroke
instrument Bool
realize_patterns TrackTime
akshara_dur SectionIndex
score_i SectionIndex
section_i = do
    (BlockId
block_id, SectionIndex
_, TrackId
track_id, TrackTime
at) <- forall (m :: * -> *).
M m =>
m (BlockId, SectionIndex, TrackId, TrackTime)
Selection.get_insert
    NoteTrack
note_track <- case forall a. [a] -> SectionIndex -> Maybe a
Lists.at [(SectionIndex, Score)]
Db.scores SectionIndex
score_i of
        Just (SectionIndex
_, Korvai.Single Korvai
k) -> forall (m :: * -> *) stroke.
(M m, Notation stroke, ToExpr (Stroke stroke), Ord stroke) =>
Instrument stroke
-> Bool
-> Korvai
-> SectionIndex
-> TrackTime
-> TrackTime
-> m NoteTrack
realize Instrument stroke
instrument Bool
realize_patterns Korvai
k
            SectionIndex
section_i TrackTime
akshara_dur TrackTime
at
        Just (SectionIndex
_, Korvai.Tani {}) -> forall (m :: * -> *) a. (HasCallStack, M m) => Text -> m a
Cmd.throw Text
"tani not supported"
        Maybe (SectionIndex, Score)
Nothing -> forall (m :: * -> *) a. (HasCallStack, M m) => Text -> m a
Cmd.throw forall a b. (a -> b) -> a -> b
$
            Text
"LSol.insert: index out of range: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt SectionIndex
score_i
    forall (m :: * -> *).
M m =>
BlockId -> [TrackId] -> [NoteTrack] -> m ()
ModifyNotes.write_tracks BlockId
block_id [TrackId
track_id] [NoteTrack
note_track]

realize :: (Ui.M m, Solkattu.Notation stroke,
        Expr.ToExpr (Realize.Stroke stroke), Ord stroke)
    => Korvai.Instrument stroke -> Bool -> Korvai.Korvai -> SectionIndex
    -> TrackTime -> TrackTime -> m ModifyNotes.NoteTrack
realize :: forall (m :: * -> *) stroke.
(M m, Notation stroke, ToExpr (Stroke stroke), Ord stroke) =>
Instrument stroke
-> Bool
-> Korvai
-> SectionIndex
-> TrackTime
-> TrackTime
-> m NoteTrack
realize Instrument stroke
instrument Bool
realize_patterns Korvai
korvai SectionIndex
section_i TrackTime
akshara_dur TrackTime
at = do
    [Realized stroke]
results <- forall (m :: * -> *) err a.
(HasCallStack, M m) =>
(err -> Text) -> Either err a -> m a
Ui.require_right forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$
        forall stroke.
(Notation stroke, Ord stroke) =>
Instrument stroke -> Korvai -> [Either Text (Realized stroke)]
Korvai.realize Instrument stroke
instrument forall a b. (a -> b) -> a -> b
$ SectionIndex -> Korvai -> Korvai
Korvai.index SectionIndex
section_i Korvai
korvai
    -- TODO I could probbaly abstract more than just patterns
    let abstraction :: Abstraction
abstraction = if Bool
realize_patterns
            then forall a. Monoid a => a
mempty else GroupType -> Abstraction
Format.abstract GroupType
Solkattu.GPattern
    let strokes :: [Flat (Group (Stroke stroke)) (Note stroke)]
strokes = forall a stroke.
Abstraction
-> [Flat (Group a) (Note stroke)] -> [Flat (Group a) (Note stroke)]
Format.makeGroupsAbstractScore Abstraction
abstraction forall a b. (a -> b) -> a -> b
$
            forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> a
fst [Realized stroke]
results
            -- snd is an alignment warning, which I can see well enough on the
            -- track already.
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        forall stroke g.
ToScore stroke
-> TrackTime -> TrackTime -> [Flat g (Note stroke)] -> NoteTrack
to_note_track (forall stroke.
ToExpr (Stroke stroke) =>
Instrument stroke -> ToScore stroke
Korvai.instToScore Instrument stroke
instrument) TrackTime
akshara_dur TrackTime
at [Flat (Group (Stroke stroke)) (Note stroke)]
strokes

to_note_track :: ToScore.ToScore stroke -> TrackTime -> TrackTime
    -> [S.Flat g (Realize.Note stroke)] -> ModifyNotes.NoteTrack
to_note_track :: forall stroke g.
ToScore stroke
-> TrackTime -> TrackTime -> [Flat g (Note stroke)] -> NoteTrack
to_note_track ToScore stroke
to_score TrackTime
stretch TrackTime
shift [Flat g (Note stroke)]
strokes =
    Events -> Controls -> NoteTrack
ModifyNotes.NoteTrack ([(Duration, Duration, Text)] -> Events
mk_events [(Duration, Duration, Text)]
notes) Controls
control_tracks
    where
    controls :: [(Text, [ToScore.Event])]
    ([(Duration, Duration, Text)]
notes, [(Text, [(Duration, Duration, Text)])]
controls) = forall stroke g.
ToScore stroke
-> [Flat g (Note stroke)]
-> ([(Duration, Duration, Text)],
    [(Text, [(Duration, Duration, Text)])])
ToScore.fromStrokes ToScore stroke
to_score [Flat g (Note stroke)]
strokes
    pitches :: [(Duration, Duration, Text)]
pitches = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"*" [(Text, [(Duration, Duration, Text)])]
controls
    pitch_track :: Maybe (Control, Events)
pitch_track = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Duration, Duration, Text)]
pitches then forall a. Maybe a
Nothing
        else forall a. a -> Maybe a
Just (ScaleId -> Control
ModifyNotes.Pitch ScaleId
Pitch.empty_scale, [(Duration, Duration, Text)] -> Events
mk_events [(Duration, Duration, Text)]
pitches)
    control_tracks :: Controls
control_tracks = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) Maybe (Control, Events)
pitch_track forall a b. (a -> b) -> a -> b
$
        [ (Control -> Control
ModifyNotes.Control (Text -> Control
ScoreT.Control Text
control), [(Duration, Duration, Text)] -> Events
mk_events [(Duration, Duration, Text)]
events)
        | (Text
control, [(Duration, Duration, Text)]
events) <- [(Text, [(Duration, Duration, Text)])]
controls
        , Text
control forall a. Eq a => a -> a -> Bool
/= Text
"*"
        ]
    mk_events :: [(Duration, Duration, Text)] -> Events
mk_events = [Event] -> Events
Events.from_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (Real a, Real a) => (a, a, Text) -> Event
mk_event
    mk_event :: (a, a, Text) -> Event
mk_event (a
start, a
dur, Text
text) = TrackTime -> TrackTime -> Event -> Event
place TrackTime
shift TrackTime
stretch forall a b. (a -> b) -> a -> b
$
        TrackTime -> TrackTime -> Text -> Event
Event.event (forall a b. (Real a, Fractional b) => a -> b
realToFrac a
start) (forall a b. (Real a, Fractional b) => a -> b
realToFrac a
dur) Text
text

place :: TrackTime -> TrackTime -> Event.Event -> Event.Event
place :: TrackTime -> TrackTime -> Event -> Event
place TrackTime
shift TrackTime
stretch = (Lens Event TrackTime
Event.duration_ forall f a. Lens f a -> (a -> a) -> f -> f
%= (forall a. Num a => a -> a -> a
*TrackTime
stretch))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens Event TrackTime
Event.start_ forall f a. Lens f a -> (a -> a) -> f -> f
%= ((forall a. Num a => a -> a -> a
+TrackTime
shift) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
*TrackTime
stretch)))

strokes_to_events :: Expr.ToExpr (Realize.Stroke a)
    => [S.Flat g (Realize.Note a)] -> [Event.Event]
strokes_to_events :: forall a g. ToExpr (Stroke a) => [Flat g (Note a)] -> [Event]
strokes_to_events [Flat g (Note a)]
strokes =
    [ TrackTime -> TrackTime -> Text -> Event
Event.event (forall a b. (Real a, Fractional b) => a -> b
realToFrac Duration
start) (if Bool
has_dur then forall a b. (Real a, Fractional b) => a -> b
realToFrac Duration
dur else TrackTime
0)
        (forall a. ShowVal a => a -> Text
ShowVal.show_val Expr MiniVal
expr)
    | (Duration
start, Duration
dur, Just Expr MiniVal
expr, Bool
has_dur) <-
        forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
List.zip4 [Duration]
starts [Duration]
durs
            (forall a b. (a -> b) -> [a] -> [b]
map forall stroke.
ToExpr (Stroke stroke) =>
Note stroke -> Maybe (Expr MiniVal)
ToScore.toExpr [Note a]
notes) (forall a b. (a -> b) -> [a] -> [b]
map forall a. HasMatras a => a -> Bool
S.hasSustain [Note a]
notes)
    ]
    where
    starts :: [Duration]
starts = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) Duration
0 [Duration]
durs
    ([Duration]
durs, [Note a]
notes) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall g a. [Flat g a] -> [a]
S.flattenedNotes forall a b. (a -> b) -> a -> b
$ forall a g. HasMatras a => [Flat g a] -> [Flat g (Duration, a)]
S.withDurations [Flat g (Note a)]
strokes

-- * integrate

-- | Find the korvai, do 'integrate_track' for it, and open an editor on the
-- source file.  The editor has bindings to 'reintegrate' after an edit.
edit_new :: Cmd.M m => Korvai.Korvai -> SectionIndex -> Text
    -> m ReplProtocol.Result
edit_new :: forall (m :: * -> *).
M m =>
Korvai -> SectionIndex -> Text -> m Result
edit_new Korvai
korvai SectionIndex
index Text
instrument = do
    Text
key <- forall (m :: * -> *).
M m =>
Korvai -> SectionIndex -> Text -> m Text
integrate_track Korvai
korvai SectionIndex
index Text
instrument
    forall (m :: * -> *). M m => Text -> m Result
edit Text
key

-- | Find the SourceKey of integrated events around the cursor.
get_key :: Cmd.M m => m Block.SourceKey
get_key :: forall (m :: * -> *). M m => m Text
get_key = do
    (TrackId
_, [Event]
events) <- forall (m :: * -> *). M m => m (TrackId, [Event])
Selection.track_events
    forall (m :: * -> *) a.
(HasCallStack, M m) =>
Text -> Maybe a -> m a
Cmd.require Text
"no key" forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Event -> Maybe Text
event_key [Event]
events

edit :: Ui.M m => Block.SourceKey -> m ReplProtocol.Result
edit :: forall (m :: * -> *). M m => Text -> m Result
edit Text
key = do
    (Korvai
korvai, SectionIndex
_, GInstrument
_) <- forall (m :: * -> *) a.
(HasCallStack, M m) =>
Text -> Maybe a -> m a
Ui.require (Text
"no korvai for " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Text
key) forall a b. (a -> b) -> a -> b
$
        Text -> Maybe (Korvai, SectionIndex, GInstrument)
get_by_key Text
key
    let (Text
module_, SectionIndex
line_number, Text
_) = Korvai -> (Text, SectionIndex, Text)
Metadata.korvaiLocation Korvai
korvai
        fname :: FilePath
fname = Text -> FilePath
module_to_fname Text
module_
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ NonEmpty Editor -> Result
ReplProtocol.Edit forall a b. (a -> b) -> a -> b
$ (forall a. a -> [a] -> NonEmpty a
:| []) forall a b. (a -> b) -> a -> b
$ ReplProtocol.Editor
        { _file :: File
_file = FilePath -> File
ReplProtocol.FileName FilePath
fname
        , _line_number :: SectionIndex
_line_number = SectionIndex
line_number
        , _on_save :: Maybe Text
_on_save = forall a. Maybe a
Nothing
        , _on_send :: Maybe Text
_on_send = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text
":reload; LSol.reintegrate " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Text
key
        }

module_to_fname :: Text -> FilePath
module_to_fname :: Text -> FilePath
module_to_fname = Text -> FilePath
untxt forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<>Text
".hs") forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text.replace Text
"." Text
"/"

-- | This can be called manually to reintegrate after a change, but is also
-- called automatically by 'edit'.
reintegrate :: Ui.M m => Block.SourceKey -> m ()
reintegrate :: forall (m :: * -> *). M m => Text -> m ()
reintegrate Text
key = do
    (Korvai
korvai, SectionIndex
index, GInstrument
inst) <- forall (m :: * -> *) a.
(HasCallStack, M m) =>
Text -> Maybe a -> m a
Ui.require (Text
"no korvai for " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Text
key) forall a b. (a -> b) -> a -> b
$
        Text -> Maybe (Korvai, SectionIndex, GInstrument)
get_by_key Text
key
    -- TODO I need to store realize_patterns and akshara_dur somewhere.
    (Track
note, [Track]
controls) <- Text -> NoteTrack -> (Track, [Track])
Manual.convert_note_track Text
key forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case GInstrument
inst of
        Korvai.GInstrument Instrument stroke
inst ->
            forall (m :: * -> *) stroke.
(M m, Notation stroke, ToExpr (Stroke stroke), Ord stroke) =>
Instrument stroke
-> Bool
-> Korvai
-> SectionIndex
-> TrackTime
-> TrackTime
-> m NoteTrack
realize Instrument stroke
inst Bool
True Korvai
korvai SectionIndex
index TrackTime
akshara_dur TrackTime
start
    forall (m :: * -> *). M m => Text -> Track -> [Track] -> m ()
Integrate.manual_integrate Text
key Track
note [Track]
controls
    where
    akshara_dur :: TrackTime
akshara_dur = TrackTime
1
    start :: TrackTime
start = TrackTime
0

event_key :: Event.Event -> Maybe Block.SourceKey
event_key :: Event -> Maybe Text
event_key Event
event = case Event -> Maybe Stack
Event.stack Event
event of
    Just (Event.Stack Stack
stack TrackTime
_) -> case Stack -> [Frame]
Stack.innermost Stack
stack of
        Stack.Call Text
key : [Frame]
_ -> forall a. a -> Maybe a
Just Text
key
        [Frame]
_ -> forall a. Maybe a
Nothing
    Maybe Stack
Nothing -> forall a. Maybe a
Nothing

-- | Get the SourceKey, create an empty track with that.
integrate_track :: Cmd.M m => Korvai.Korvai -> SectionIndex -> Text
    -> m Block.SourceKey
integrate_track :: forall (m :: * -> *).
M m =>
Korvai -> SectionIndex -> Text -> m Text
integrate_track Korvai
korvai SectionIndex
index Text
instrument = do
    Text
key <- forall (m :: * -> *) a.
(HasCallStack, M m) =>
Text -> Maybe a -> m a
Cmd.require Text
"can't get key" forall a b. (a -> b) -> a -> b
$ Korvai -> SectionIndex -> Text -> Maybe Text
korvai_key Korvai
korvai SectionIndex
index Text
instrument
    ViewId
view_id <- forall (m :: * -> *). M m => m ViewId
Cmd.get_focused_view
    TrackId
track_id <- forall (m :: * -> *).
M m =>
Bool -> ViewId -> SectionIndex -> m TrackId
Create.track_and_widen Bool
False ViewId
view_id SectionIndex
9999
    -- This is surely wrong, but I don't know the intended instrument here, and
    -- it can be fixed by hand, and it only happens the first time.
    forall (m :: * -> *). M m => TrackId -> Text -> m ()
Ui.set_track_title TrackId
track_id (Text
">" forall a. Semigroup a => a -> a -> a
<> Text
instrument)
    BlockId
block_id <- forall (m :: * -> *). M m => ViewId -> m BlockId
Ui.block_id_of ViewId
view_id
    forall (m :: * -> *).
M m =>
BlockId -> Text -> Maybe [NoteDestination] -> m ()
Ui.set_integrated_manual BlockId
block_id Text
key forall a b. (a -> b) -> a -> b
$
        forall a. a -> Maybe a
Just [Text -> TrackId -> [(Text, TrackId)] -> NoteDestination
Block.empty_destination Text
key TrackId
track_id []]
    forall (m :: * -> *). M m => Text -> m ()
reintegrate Text
key
    forall (m :: * -> *) a. Monad m => a -> m a
return Text
key

korvai_key :: Korvai.Korvai -> SectionIndex -> Text -> Maybe Block.SourceKey
korvai_key :: Korvai -> SectionIndex -> Text -> Maybe Text
korvai_key Korvai
korvai SectionIndex
index Text
instrument = do
    let (Text
module_, SectionIndex
_, Text
variable) = Korvai -> (Text, SectionIndex, Text)
Metadata.korvaiLocation Korvai
korvai
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
"/" [Text
module_, Text
variable, forall a. Show a => a -> Text
showt SectionIndex
index, Text
instrument]

get_by_key :: Block.SourceKey
    -> Maybe (Korvai.Korvai, SectionIndex, Korvai.GInstrument)
get_by_key :: Text -> Maybe (Korvai, SectionIndex, GInstrument)
get_by_key Text
key = do
    -- (mod, variable, index) <- split3 key
    [Text
mod, Text
variable, Text
index, Text
instrument] <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text.splitOn Text
"/" Text
key
    SectionIndex
index <- forall a. Parser a -> Text -> Maybe a
ParseText.maybe_parse Parser SectionIndex
ParseText.p_nat Text
index
    Score
score <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Text -> Text -> Score -> Bool
matches Text
mod Text
variable) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(SectionIndex, Score)]
Db.scores)
    Korvai
korvai <- case Score
score of
        Korvai.Single Korvai
k -> forall (m :: * -> *) a. Monad m => a -> m a
return Korvai
k
        Korvai.Tani {} -> forall a. HasCallStack => FilePath -> a
error FilePath
"Tani not supported yet"
    GInstrument
instrument <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((forall a. Eq a => a -> a -> Bool
==Text
instrument) forall b c a. (b -> c) -> (a -> b) -> a -> c
. GInstrument -> Text
Korvai.ginstrumentName)
        [GInstrument]
Korvai.instruments
    -- This means reintegrate only works with a single section a single korvai.
    -- I can extend it if this turns out to be too restrictive.
    forall (m :: * -> *) a. Monad m => a -> m a
return (Korvai
korvai, SectionIndex
index, GInstrument
instrument)
    where
    -- split3 t = case Text.splitOn "/" t of
    --     [a, b, c] -> Just (a, b, c)
    --     _ -> Nothing
    matches :: Text -> Text -> Score -> Bool
matches Text
mod Text
variable Score
score = Text
m forall a. Eq a => a -> a -> Bool
== Text
mod Bool -> Bool -> Bool
&& Text
v forall a. Eq a => a -> a -> Bool
== Text
variable
        where (Text
m, SectionIndex
_, Text
v) = Score -> (Text, SectionIndex, Text)
Metadata.scoreLocation Score
score