content: -- Copyright 2013 Evan Laforge
  -- This program is distributed under the terms of the GNU General Public
  -- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt
  
  {- | A simple tag-oriented query language, and an index for fast-ish searching.
  
      The syntax is documented by 'Query'.
  -}
  module Instrument.Search where
  import qualified Data.List as List
  import qualified Data.Map as Map
  import qualified Data.Set as Set
  import qualified Data.Text as Text
  
  import qualified Util.Lists as Lists
  import qualified Util.Maps as Maps
  import qualified Derive.ScoreT as ScoreT
  import qualified Instrument.Common as Common
  import qualified Instrument.Inst as Inst
  import qualified Instrument.InstT as InstT
  import qualified Instrument.Tag as Tag
  
  import qualified Midi.Midi as Midi
  import qualified Perform.Midi.Control as Control
  import qualified Perform.Midi.Patch as Patch
  
  import           Global
  
  
  type Search = Query -> [InstT.Qualified]
  
  {- | A simple tag-oriented query language.  Instruments match whose tags match
      all of the given TagKeys exactly, and whose corresponding vals have the
      queried val as a substring.  All the pairs must match, but pairs that match
      nothing won't cause the match to fail.  A tag beginning with @!@ will
      subtract its matches from the result.
  
      For example, a single word @tag1@ will match all instruments that have the
      given tag.  @tag1=x@ requires that tag1 has an \"x\" in it.
  
      @tag1=x tag2=y !bad !not=want@ requires both tags to match, the @bad@ tag
      to not be present, and the @not@ tag to not contain \"want\".
      -}
  newtype Query = Query [Clause]
      deriving (Show)
  
  -- | Clause inverted? tag val
  data Clause = Clause Bool Tag.Key Tag.Value
      deriving (Show)
  
  -- | Search the db.  The input Query is in the parsed db query language, and
  -- the output is the names of matching patches, along with their backend.
  --
  -- An empty query matches everything.
  search :: Index -> Search
  search idx (Query []) = Map.keys (idx_instrument_tags idx)
  search idx (Query clauses)
      | null positive = []
      | otherwise = Set.toList $
          foldl1 Set.intersection positive `Set.difference` negative
      where
      positive
          | null kvs = [Map.keysSet (idx_instrument_tags idx)]
          | otherwise = filter (not . Set.null) $ map Set.fromList $
              query_matches idx kvs
          where kvs = [(k, v) | Clause False k v <- clauses]
      negative = Set.fromList $ concat $
          query_matches idx [(k, v) | Clause True k v <- clauses]
  
  tags_of :: Index -> InstT.Qualified -> Maybe [Tag.Tag]
  tags_of idx inst = Map.lookup inst (idx_instrument_tags idx)
  
  data Index = Index {
      idx_by_key :: Map Tag.Key (Map Tag.Value [InstT.Qualified])
      , idx_instrument_tags :: Map InstT.Qualified [Tag.Tag]
      } deriving (Show)
  
  empty_index :: Index
  empty_index = Index Map.empty Map.empty
  
  -- | Merge the indices, favoring instruments from the left one.
  merge_indices :: Index -> Index -> Index
  merge_indices (Index keys0 inv0) (Index keys1 inv1) =
      Index (merge_keys keys0 keys1) (Map.union inv0 inv1)
      where
      merge_keys = Map.unionWith merge_vals
      merge_vals = Map.unionWith (++)
  
  make_index :: Inst.Db code -> Index
  make_index db = Index
      { idx_by_key = Map.map Maps.multimap (Maps.multimap idx)
      , idx_instrument_tags = Map.fromList inst_tags
      }
      where
      inst_tags = instrument_tags db
      idx = [(key, (val, inst)) | (inst, tags) <- inst_tags, (key, val) <- tags]
  
  -- | The query language looks like \"a b= c=d !e=f\", which means
  --
  -- > Query [Clause False "a" "", Clause False "b" "", Clause False "c" "d",
  -- >    Clause True "e" "f"]
  --
  -- TODO parse quotes for keys or vals with spaces
  parse :: Text -> Query
  parse = Query . map clause . Text.words
      where
      clause word
          | Just ('!', pre) <- Text.uncons pre =
              Clause True pre (Text.drop 1 post)
          | otherwise = Clause False pre (Text.drop 1 post)
          where (pre, post) = Text.break (=='=') word
  
  -- * implementation
  
  query_matches :: Index -> [(Tag.Key, Tag.Value)] -> [[InstT.Qualified]]
  query_matches (Index idx _) = map with_tag
      where
      with_tag (key, val) = case Map.lookup key idx of
          Nothing -> []
          Just vals -> concatMap snd $ filter ((val `Text.isInfixOf`) . fst)
              (Map.assocs vals)
  
  instrument_tags :: Inst.Db code -> [(InstT.Qualified, [Tag.Tag])]
  instrument_tags = concatMap synth_tags . Inst.synths
  
  synth_tags :: (InstT.SynthName, Inst.Synth code)
      -> [(InstT.Qualified, [Tag.Tag])]
  synth_tags (synth_name, synth) = do
      (inst_name, inst) <- Map.toList (Inst.synth_insts synth)
      let tags = normalize_tags $
              common_tags synth_name inst_name (Inst.inst_common inst)
              ++ inst_tags (Inst.inst_backend inst)
      return (InstT.Qualified synth_name inst_name, tags)
  
  common_tags :: InstT.SynthName -> InstT.Name -> Common.Common code -> [Tag.Tag]
  common_tags synth_name inst_name common =
      (Tag.synth, synth_name)
      : (Tag.name, inst_name)
      : Common.common_tags common
  
  -- | Get tags of an inst, including automatically generated tags.
  inst_tags :: Inst.Backend -> [Tag.Tag]
  inst_tags = \case
      Inst.Midi patch -> concat
          [ [(Tag.backend, "midi")]
          , control_tags $ Patch.patch_control_map patch
          , case Patch.patch_initialize patch of
              Patch.InitializeMidi msgs
                  | any Midi.is_sysex msgs -> [(Tag.sysex, "")]
                  | otherwise -> []
              _ -> []
          ]
      Inst.Im {} -> [(Tag.backend, "im")]
      Inst.Sc {} -> [(Tag.backend, "sc")]
      Inst.Dummy {} -> []
  
  normalize_tags :: [Tag.Tag] -> [Tag.Tag]
  normalize_tags =
      Lists.dropDups id . List.sort . map (bimap Text.toLower Text.toLower)
  
  control_tags :: Control.ControlMap -> [Tag.Tag]
  control_tags = map ((,) Tag.control . ScoreT.control_name) . Map.keys
  