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

{- | This is called Inst because I already have way too many modules named
    Instrument and I couldn't think of anything better.  TODO think of
    something better.

    The hierarchy, from general to specific goes:

    - 'InstT.Qualified' - global name of an Inst, used to instantiate
    a ScoreTypes.Instrument.

    - 'ScoreTypes.Instrument' - name an instance of an Inst within a score

    - 'Inst' - instrument encompassing all backends.

    - Patch - backend-specific instrument

    Instrument configuration is divided into static (built-in to the instrument)
    and dynamic (configured per score).

    Static configuration starts with 'Inst', and is divided into 'Backend'
    specific and 'Common.Common'.

    Dynamic configuration starts with 'Ui.StateConfig.Allocation' and is also
    divided into 'Ui.StateConfig.Backend' specific and 'Common.Config'.  When
    a new allocation is created, the 'Midi.Patch.patch_defaults' are copied
    to 'Midi.Patch.config_settings'.
-}
module Instrument.Inst (
    -- * Inst
    Inst(..), common, backend, Backend(..), backend_name
    , inst_midi, inst_attributes
    -- * db
    , Db, Synth(..), empty, size, synth_names, synths, lookup_synth, lookup
    , SynthDecl(..), db, merge
    , annotate
) where
import           Prelude hiding (lookup)
import qualified Data.Map as Map

import qualified Util.Lens as Lens
import qualified Util.Maps as Maps
import qualified Util.Num as Num
import qualified Util.Pretty as Pretty

import qualified Derive.Attrs as Attrs
import qualified Instrument.Common as Common
import qualified Instrument.InstT as InstT
import qualified Instrument.Tag as Tag

import qualified Perform.Im.Patch as Im.Patch
import qualified Perform.Midi.Patch as Midi.Patch
import qualified Perform.Sc.Patch as Sc.Patch

import           Global


-- * Inst

data Inst code = Inst {
    forall code. Inst code -> Backend
inst_backend :: !Backend
    , forall code. Inst code -> Common code
inst_common :: !(Common.Common code)
    } deriving (Int -> Inst code -> ShowS
[Inst code] -> ShowS
Inst code -> String
(Int -> Inst code -> ShowS)
-> (Inst code -> String)
-> ([Inst code] -> ShowS)
-> Show (Inst code)
forall code. Show code => Int -> Inst code -> ShowS
forall code. Show code => [Inst code] -> ShowS
forall code. Show code => Inst code -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inst code] -> ShowS
$cshowList :: forall code. Show code => [Inst code] -> ShowS
show :: Inst code -> String
$cshow :: forall code. Show code => Inst code -> String
showsPrec :: Int -> Inst code -> ShowS
$cshowsPrec :: forall code. Show code => Int -> Inst code -> ShowS
Show)

backend :: Inst code :-> Backend
backend = (Inst code -> Backend)
-> ((Backend -> Backend) -> Inst code -> Inst code)
-> Inst code :-> Backend
forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Inst code -> Backend
forall code. Inst code -> Backend
inst_backend
    (\Backend -> Backend
f Inst code
r -> Inst code
r { inst_backend :: Backend
inst_backend = Backend -> Backend
f (Inst code -> Backend
forall code. Inst code -> Backend
inst_backend Inst code
r) })
common :: Inst code :-> Common code
common = (Inst code -> Common code)
-> ((Common code -> Common code) -> Inst code -> Inst code)
-> Inst code :-> Common code
forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Inst code -> Common code
forall code. Inst code -> Common code
inst_common (\Common code -> Common code
f Inst code
r -> Inst code
r { inst_common :: Common code
inst_common = Common code -> Common code
f (Inst code -> Common code
forall code. Inst code -> Common code
inst_common Inst code
r) })

instance Pretty code => Pretty (Inst code) where
    format :: Inst code -> Doc
format (Inst Backend
backend Common code
common) = Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"Inst"
        [ (Text
"backend", Backend -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Backend
backend)
        , (Text
"common", Common code -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Common code
common)
        ]

data Backend =
    -- | A Dummy instrument should be resolved to concrete instruments during
    -- derivation.  It includes an error msg show if that doesn't happen.
    Dummy !Text
    | Midi !Midi.Patch.Patch
    | Im !Im.Patch.Patch
    | Sc !Sc.Patch.Patch
    deriving (Int -> Backend -> ShowS
[Backend] -> ShowS
Backend -> String
(Int -> Backend -> ShowS)
-> (Backend -> String) -> ([Backend] -> ShowS) -> Show Backend
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Backend] -> ShowS
$cshowList :: [Backend] -> ShowS
show :: Backend -> String
$cshow :: Backend -> String
showsPrec :: Int -> Backend -> ShowS
$cshowsPrec :: Int -> Backend -> ShowS
Show)

instance Pretty Backend where
    format :: Backend -> Doc
format = \case
        Dummy Text
msg -> Doc
"Dummy \"" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
Pretty.text Text
msg Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"\""
        Midi Patch
patch -> Patch -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Patch
patch
        Im Patch
patch -> Patch -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Patch
patch
        Sc Patch
patch -> Patch -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Patch
patch

backend_name :: Backend -> Text
backend_name :: Backend -> Text
backend_name = \case
    Dummy {} -> Text
"dummy"
    Midi {} -> Text
"midi"
    Im {} -> Text
"音"
    Sc {} -> Text
"sc"

inst_midi :: Inst code -> Maybe Midi.Patch.Patch
inst_midi :: forall code. Inst code -> Maybe Patch
inst_midi Inst code
inst = case Inst code -> Backend
forall code. Inst code -> Backend
inst_backend Inst code
inst of
    Midi Patch
inst -> Patch -> Maybe Patch
forall a. a -> Maybe a
Just Patch
inst
    Backend
_ -> Maybe Patch
forall a. Maybe a
Nothing

inst_attributes :: Inst code -> [Attrs.Attributes]
inst_attributes :: forall code. Inst code -> [Attributes]
inst_attributes Inst code
inst = case Inst code -> Backend
forall code. Inst code -> Backend
inst_backend Inst code
inst of
    Dummy {} -> []
    Midi Patch
patch -> AttributeMap ([Keyswitch], Maybe Keymap) -> [Attributes]
forall a. AttributeMap a -> [Attributes]
Common.mapped_attributes (AttributeMap ([Keyswitch], Maybe Keymap) -> [Attributes])
-> AttributeMap ([Keyswitch], Maybe Keymap) -> [Attributes]
forall a b. (a -> b) -> a -> b
$
        Patch -> AttributeMap ([Keyswitch], Maybe Keymap)
Midi.Patch.patch_attribute_map Patch
patch
    Im Patch
patch -> AttributeMap () -> [Attributes]
forall a. AttributeMap a -> [Attributes]
Common.mapped_attributes (AttributeMap () -> [Attributes])
-> AttributeMap () -> [Attributes]
forall a b. (a -> b) -> a -> b
$
        Patch -> AttributeMap ()
Im.Patch.patch_attribute_map Patch
patch
    Sc Patch
_patch -> []

-- * Db

newtype Db code = Db (Map InstT.SynthName (Synth code))
    deriving (Int -> Db code -> ShowS
[Db code] -> ShowS
Db code -> String
(Int -> Db code -> ShowS)
-> (Db code -> String) -> ([Db code] -> ShowS) -> Show (Db code)
forall code. Show code => Int -> Db code -> ShowS
forall code. Show code => [Db code] -> ShowS
forall code. Show code => Db code -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Db code] -> ShowS
$cshowList :: forall code. Show code => [Db code] -> ShowS
show :: Db code -> String
$cshow :: forall code. Show code => Db code -> String
showsPrec :: Int -> Db code -> ShowS
$cshowsPrec :: forall code. Show code => Int -> Db code -> ShowS
Show, [Db code] -> Doc
Db code -> Text
Db code -> Doc
(Db code -> Text)
-> (Db code -> Doc) -> ([Db code] -> Doc) -> Pretty (Db code)
forall code. Pretty code => [Db code] -> Doc
forall code. Pretty code => Db code -> Text
forall code. Pretty code => Db code -> Doc
forall a. (a -> Text) -> (a -> Doc) -> ([a] -> Doc) -> Pretty a
formatList :: [Db code] -> Doc
$cformatList :: forall code. Pretty code => [Db code] -> Doc
format :: Db code -> Doc
$cformat :: forall code. Pretty code => Db code -> Doc
pretty :: Db code -> Text
$cpretty :: forall code. Pretty code => Db code -> Text
Pretty)

data Synth code = Synth {
    -- | Full name, just for documentation.
    forall code. Synth code -> Text
synth_doc :: !Text
    , forall code. Synth code -> Map Text (Inst code)
synth_insts :: !(Map InstT.Name (Inst code))
    } deriving (Int -> Synth code -> ShowS
[Synth code] -> ShowS
Synth code -> String
(Int -> Synth code -> ShowS)
-> (Synth code -> String)
-> ([Synth code] -> ShowS)
-> Show (Synth code)
forall code. Show code => Int -> Synth code -> ShowS
forall code. Show code => [Synth code] -> ShowS
forall code. Show code => Synth code -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Synth code] -> ShowS
$cshowList :: forall code. Show code => [Synth code] -> ShowS
show :: Synth code -> String
$cshow :: forall code. Show code => Synth code -> String
showsPrec :: Int -> Synth code -> ShowS
$cshowsPrec :: forall code. Show code => Int -> Synth code -> ShowS
Show)

insts :: Synth code :-> Map Text (Inst code)
insts = (Synth code -> Map Text (Inst code))
-> ((Map Text (Inst code) -> Map Text (Inst code))
    -> Synth code -> Synth code)
-> Synth code :-> Map Text (Inst code)
forall f a. (f -> a) -> ((a -> a) -> f -> f) -> f :-> a
Lens.lens Synth code -> Map Text (Inst code)
forall code. Synth code -> Map Text (Inst code)
synth_insts (\Map Text (Inst code) -> Map Text (Inst code)
f Synth code
r -> Synth code
r { synth_insts :: Map Text (Inst code)
synth_insts = Map Text (Inst code) -> Map Text (Inst code)
f (Synth code -> Map Text (Inst code)
forall code. Synth code -> Map Text (Inst code)
synth_insts Synth code
r) })

instance Pretty code => Pretty (Synth code) where
    format :: Synth code -> Doc
format (Synth Text
_ Map Text (Inst code)
insts) = Map Text (Inst code) -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Map Text (Inst code)
insts

empty :: Db code
empty :: forall code. Db code
empty = Map Text (Synth code) -> Db code
forall code. Map Text (Synth code) -> Db code
Db Map Text (Synth code)
forall a. Monoid a => a
mempty

-- | Number of 'Inst's in the db.
size :: Db code -> Int
size :: forall code. Db code -> Int
size (Db Map Text (Synth code)
db) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Synth code -> Int) -> [Synth code] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Map Text (Inst code) -> Int
forall k a. Map k a -> Int
Map.size (Map Text (Inst code) -> Int)
-> (Synth code -> Map Text (Inst code)) -> Synth code -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synth code -> Map Text (Inst code)
forall code. Synth code -> Map Text (Inst code)
synth_insts) ([Synth code] -> [Int]) -> [Synth code] -> [Int]
forall a b. (a -> b) -> a -> b
$ Map Text (Synth code) -> [Synth code]
forall k a. Map k a -> [a]
Map.elems Map Text (Synth code)
db

synth_names :: Db code -> [InstT.SynthName]
synth_names :: forall code. Db code -> [Text]
synth_names (Db Map Text (Synth code)
db) = Map Text (Synth code) -> [Text]
forall k a. Map k a -> [k]
Map.keys Map Text (Synth code)
db

synths :: Db code -> [(InstT.SynthName, Synth code)]
synths :: forall code. Db code -> [(Text, Synth code)]
synths (Db Map Text (Synth code)
db) = Map Text (Synth code) -> [(Text, Synth code)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text (Synth code)
db

lookup_synth :: InstT.SynthName -> Db code -> Maybe (Synth code)
lookup_synth :: forall code. Text -> Db code -> Maybe (Synth code)
lookup_synth Text
synth (Db Map Text (Synth code)
db) = Text -> Map Text (Synth code) -> Maybe (Synth code)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
synth Map Text (Synth code)
db

lookup :: InstT.Qualified -> Db code -> Maybe (Inst code)
lookup :: forall code. Qualified -> Db code -> Maybe (Inst code)
lookup (InstT.Qualified Text
synth Text
name) (Db Map Text (Synth code)
db) =
    Text -> Map Text (Inst code) -> Maybe (Inst code)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name (Map Text (Inst code) -> Maybe (Inst code))
-> (Synth code -> Map Text (Inst code))
-> Synth code
-> Maybe (Inst code)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synth code -> Map Text (Inst code)
forall code. Synth code -> Map Text (Inst code)
synth_insts (Synth code -> Maybe (Inst code))
-> Maybe (Synth code) -> Maybe (Inst code)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Map Text (Synth code) -> Maybe (Synth code)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
synth Map Text (Synth code)
db

-- | Unchecked synth declaration.  'db' will check it for duplicates and other
-- problems.  (name, doc, patches)
data SynthDecl code =
    SynthDecl !InstT.SynthName !Text ![(InstT.Name, Inst code)]
    deriving (Int -> SynthDecl code -> ShowS
[SynthDecl code] -> ShowS
SynthDecl code -> String
(Int -> SynthDecl code -> ShowS)
-> (SynthDecl code -> String)
-> ([SynthDecl code] -> ShowS)
-> Show (SynthDecl code)
forall code. Show code => Int -> SynthDecl code -> ShowS
forall code. Show code => [SynthDecl code] -> ShowS
forall code. Show code => SynthDecl code -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SynthDecl code] -> ShowS
$cshowList :: forall code. Show code => [SynthDecl code] -> ShowS
show :: SynthDecl code -> String
$cshow :: forall code. Show code => SynthDecl code -> String
showsPrec :: Int -> SynthDecl code -> ShowS
$cshowsPrec :: forall code. Show code => Int -> SynthDecl code -> ShowS
Show)

instance Pretty code => Pretty (SynthDecl code) where
    format :: SynthDecl code -> Doc
format (SynthDecl Text
name Text
doc [(Text, Inst code)]
insts) = Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"SynthDecl"
        [ (Text
"name", Text -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Text
name)
        , (Text
"doc", Text -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Text
doc)
        , (Text
"instruments", [(Text, Inst code)] -> Doc
forall a. Pretty a => a -> Doc
Pretty.format [(Text, Inst code)]
insts)
        ]

-- | Construct and validate a Db, returning any errors that occurred.
db :: [SynthDecl code] -> (Db code, [Text])
db :: forall code. [SynthDecl code] -> (Db code, [Text])
db [SynthDecl code]
synth_decls = (Map Text (Synth code) -> Db code
forall code. Map Text (Synth code) -> Db code
Db Map Text (Synth code)
db, [Text]
synth_errors [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
inst_errors [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
validate_errors)
    where
    ([(Text, Synth code)]
inst_maps, [Text]
inst_errors) = ([[Text]] -> [Text])
-> ([(Text, Synth code)], [[Text]])
-> ([(Text, Synth code)], [Text])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (([(Text, Synth code)], [[Text]])
 -> ([(Text, Synth code)], [Text]))
-> ([(Text, Synth code)], [[Text]])
-> ([(Text, Synth code)], [Text])
forall a b. (a -> b) -> a -> b
$ [((Text, Synth code), [Text])] -> ([(Text, Synth code)], [[Text]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([((Text, Synth code), [Text])]
 -> ([(Text, Synth code)], [[Text]]))
-> [((Text, Synth code), [Text])]
-> ([(Text, Synth code)], [[Text]])
forall a b. (a -> b) -> a -> b
$ do
        SynthDecl Text
synth Text
synth_doc [(Text, Inst code)]
insts <- [SynthDecl code]
synth_decls
        let (Map Text (Inst code)
inst_map, [(Text, Inst code)]
dups) = [(Text, Inst code)] -> (Map Text (Inst code), [(Text, Inst code)])
forall a b. Ord a => [(a, b)] -> (Map a b, [(a, b)])
Maps.unique [(Text, Inst code)]
insts
        let errors :: [Text]
errors =
                [ Text
"duplicate inst: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Qualified -> Text
forall a. Pretty a => a -> Text
pretty (Text -> Text -> Qualified
InstT.Qualified Text
synth Text
name)
                | Text
name <- ((Text, Inst code) -> Text) -> [(Text, Inst code)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Inst code) -> Text
forall a b. (a, b) -> a
fst [(Text, Inst code)]
dups
                ]
        ((Text, Synth code), [Text]) -> [((Text, Synth code), [Text])]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text
synth, Text -> Map Text (Inst code) -> Synth code
forall code. Text -> Map Text (Inst code) -> Synth code
Synth Text
synth_doc Map Text (Inst code)
inst_map), [Text]
errors)
    (Map Text (Synth code)
db, [(Text, Synth code)]
dups) = [(Text, Synth code)]
-> (Map Text (Synth code), [(Text, Synth code)])
forall a b. Ord a => [(a, b)] -> (Map a b, [(a, b)])
Maps.unique [(Text, Synth code)]
inst_maps
    synth_errors :: [Text]
synth_errors = [Text
"duplicate synth: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
showt Text
synth | Text
synth <- ((Text, Synth code) -> Text) -> [(Text, Synth code)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Synth code) -> Text
forall a b. (a, b) -> a
fst [(Text, Synth code)]
dups]
    validate_errors :: [Text]
validate_errors = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Qualified -> Text
forall a. Pretty a => a -> Text
pretty (Text -> Text -> Qualified
InstT.Qualified Text
synth Text
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": ") <>)
            (Inst code -> [Text]
forall code. Inst code -> [Text]
validate Inst code
inst)
        | SynthDecl Text
synth Text
_ [(Text, Inst code)]
insts <- [SynthDecl code]
synth_decls, (Text
name, Inst code
inst) <- [(Text, Inst code)]
insts
        ]

-- | Return any errors found in the Inst.
validate :: Inst code -> [Text]
validate :: forall code. Inst code -> [Text]
validate Inst code
inst = case Inst code -> Backend
forall code. Inst code -> Backend
inst_backend Inst code
inst of
    Dummy {} -> []
    Midi Patch
patch -> AttributeMap ([Keyswitch], Maybe Keymap) -> [Text]
forall a. AttributeMap a -> [Text]
Common.overlapping_attributes (AttributeMap ([Keyswitch], Maybe Keymap) -> [Text])
-> AttributeMap ([Keyswitch], Maybe Keymap) -> [Text]
forall a b. (a -> b) -> a -> b
$
        Patch -> AttributeMap ([Keyswitch], Maybe Keymap)
Midi.Patch.patch_attribute_map Patch
patch
    Im Patch
patch -> AttributeMap () -> [Text]
forall a. AttributeMap a -> [Text]
Common.overlapping_attributes (AttributeMap () -> [Text]) -> AttributeMap () -> [Text]
forall a b. (a -> b) -> a -> b
$
        Patch -> AttributeMap ()
Im.Patch.patch_attribute_map Patch
patch
    Sc Patch
_patch -> []

-- | Merge the Dbs, and return any duplicate synths.
merge :: Db code -> Db code -> (Db code, [InstT.SynthName])
merge :: forall code. Db code -> Db code -> (Db code, [Text])
merge (Db Map Text (Synth code)
db1) (Db Map Text (Synth code)
db2) = (Map Text (Synth code) -> Db code
forall code. Map Text (Synth code) -> Db code
Db Map Text (Synth code)
db, Map Text (Synth code) -> [Text]
forall k a. Map k a -> [k]
Map.keys Map Text (Synth code)
dups)
    where (Map Text (Synth code)
db, Map Text (Synth code)
dups) = Map Text (Synth code)
-> Map Text (Synth code)
-> (Map Text (Synth code), Map Text (Synth code))
forall k a. Ord k => Map k a -> Map k a -> (Map k a, Map k a)
Maps.uniqueUnion Map Text (Synth code)
db1 Map Text (Synth code)
db2

annotate :: Map InstT.Qualified [Tag.Tag] -> Db code
    -> (Db code, [InstT.Qualified])
annotate :: forall code.
Map Qualified [Tag] -> Db code -> (Db code, [Qualified])
annotate Map Qualified [Tag]
annots Db code
db = (Qualified
 -> [Tag] -> (Db code, [Qualified]) -> (Db code, [Qualified]))
-> (Db code, [Qualified])
-> Map Qualified [Tag]
-> (Db code, [Qualified])
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey Qualified
-> [Tag] -> (Db code, [Qualified]) -> (Db code, [Qualified])
forall {code}.
Qualified
-> [Tag] -> (Db code, [Qualified]) -> (Db code, [Qualified])
modify (Db code
db, []) Map Qualified [Tag]
annots
    where
    modify :: Qualified
-> [Tag] -> (Db code, [Qualified]) -> (Db code, [Qualified])
modify qualified :: Qualified
qualified@(InstT.Qualified Text
synth Text
name) [Tag]
tags (Db code
db, [Qualified]
not_found) =
        case Text
-> Text -> (Inst code -> Inst code) -> Db code -> Maybe (Db code)
forall code.
Text
-> Text -> (Inst code -> Inst code) -> Db code -> Maybe (Db code)
modify_inst Text
synth Text
name ([Tag] -> Inst code -> Inst code
forall {code}. [Tag] -> Inst code -> Inst code
add_tags [Tag]
tags) Db code
db of
            Maybe (Db code)
Nothing -> (Db code
db, Qualified
qualified Qualified -> [Qualified] -> [Qualified]
forall a. a -> [a] -> [a]
: [Qualified]
not_found)
            Just Db code
db -> (Db code
db, [Qualified]
not_found)
    add_tags :: [Tag] -> Inst code -> Inst code
add_tags [Tag]
tags = Inst code :-> Common code
forall {code}. Inst code :-> Common code
common(Inst code :-> Common code)
-> Lens (Common code) [Tag] -> Lens (Inst code) [Tag]
forall a b c. Lens a b -> Lens b c -> Lens a c
#Lens (Common code) [Tag]
forall {code}. Common code :-> [Tag]
Common.tags Lens (Inst code) [Tag]
-> ([Tag] -> [Tag]) -> Inst code -> Inst code
forall f a. Lens f a -> (a -> a) -> f -> f
%= ([Tag]
tags++)

modify_inst :: InstT.SynthName -> InstT.Name -> (Inst code -> Inst code)
    -> Db code -> Maybe (Db code)
modify_inst :: forall code.
Text
-> Text -> (Inst code -> Inst code) -> Db code -> Maybe (Db code)
modify_inst Text
synth Text
name Inst code -> Inst code
modify (Db Map Text (Synth code)
db) = Map Text (Synth code) -> Db code
forall code. Map Text (Synth code) -> Db code
Db (Map Text (Synth code) -> Db code)
-> Maybe (Map Text (Synth code)) -> Maybe (Db code)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    Inst code
inst <- Text -> Map Text (Inst code) -> Maybe (Inst code)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name (Map Text (Inst code) -> Maybe (Inst code))
-> (Synth code -> Map Text (Inst code))
-> Synth code
-> Maybe (Inst code)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synth code -> Map Text (Inst code)
forall code. Synth code -> Map Text (Inst code)
synth_insts (Synth code -> Maybe (Inst code))
-> Maybe (Synth code) -> Maybe (Inst code)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Map Text (Synth code) -> Maybe (Synth code)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
synth Map Text (Synth code)
db
    Map Text (Synth code) -> Maybe (Map Text (Synth code))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Synth code) -> Maybe (Map Text (Synth code)))
-> Map Text (Synth code) -> Maybe (Map Text (Synth code))
forall a b. (a -> b) -> a -> b
$ (Synth code -> Synth code)
-> Text -> Map Text (Synth code) -> Map Text (Synth code)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Synth code :-> Map Text (Inst code)
forall {code}. Synth code :-> Map Text (Inst code)
insts (Synth code :-> Map Text (Inst code))
-> (Map Text (Inst code) -> Map Text (Inst code))
-> Synth code
-> Synth code
forall f a. Lens f a -> (a -> a) -> f -> f
%= Text -> Inst code -> Map Text (Inst code) -> Map Text (Inst code)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name (Inst code -> Inst code
modify Inst code
inst)) Text
synth Map Text (Synth code)
db