content: {-# LANGUAGE ViewPatterns, TupleSections, ScopedTypeVariables, DeriveDataTypeable, PatternGuards, GADTs #-}
  
  module Output.Tags(writeTags, completionTags, applyTags) where
  
  import Data.Bifunctor
  import Data.Function
  import Data.List.Extra
  import Data.Tuple.Extra
  import Data.Maybe
  import Foreign.Storable.Tuple()
  import qualified Data.Map as Map
  import qualified Data.Set as Set
  import qualified Data.Vector.Storable as V
  import qualified Data.ByteString.Char8 as BS
  
  import Input.Item
  import Query
  import General.Util
  import General.Store
  import General.Str
  
  ---------------------------------------------------------------------
  -- DATA TYPE
  
  -- matches (a,b) if i >= a && i <= b
  
  data Packages a where Packages :: Packages (BStr0, V.Vector (TargetId, TargetId)) deriving Typeable
      -- list of packages, sorted by popularity, lowercase, interspersed with \0
      -- for each index in PackageNames, the first is the module item, any in the bounds are in that package
  
  data Modules a where Modules :: Modules (BStr0, V.Vector (TargetId, TargetId)) deriving Typeable
      -- list of modules, sorted by popularity, not unique, lowercase, interspersed with \0
      -- for each index in ModuleNames, the first is the module item, any in the bounds are in that module
  
  data Categories a where Categories :: Categories (BStr0, Jagged (TargetId, TargetId)) deriving Typeable
      -- list of categories, sorted by name, interspersed with \0
      -- for each index in CategoryNames, a range of items containing a category, first item is a package
  
  data Completions a where Completions :: Completions BStr0 deriving Typeable
      -- a list of things to complete to, interspersed with \0
  
  
  writeTags :: StoreWrite -> (PkgName -> Bool) -> (PkgName -> [(String,String)]) -> [(Maybe TargetId, Item)] -> IO ()
  writeTags store keep extra xs = do
      let splitPkg = splitIPackage xs
      let packages = addRange splitPkg
      storeWrite store Packages (bstr0Join $ map (strUnpack . fst) packages, V.fromList $ map snd packages)
  
      let categories = map (bimap snd reverse) $ Map.toList $ Map.fromListWith (++)
              [(((weightTag ex, both lower ex), joinPair ":" ex),[rng]) | (p,rng) <- packages, ex <- extra p]
      storeWrite store Categories (bstr0Join $ map fst categories, jaggedFromList $ map snd categories)
  
      let modules = addRange $ concatMap (splitIModule . snd) splitPkg
      storeWrite store Modules (bstr0Join $ map (lower . strUnpack . fst) modules, V.fromList $ map snd modules)
  
      storeWrite store Completions $ bstr0Join $
          takeWhile ("set:" `isPrefixOf`) (map fst categories) ++
          map ("package:"++) (sortOn lower $ map strUnpack $ nubOrd $ filter keep $ map fst packages) ++
          map (joinPair ":") (sortOn (weightTag &&& both lower) $ nubOrd [ex | (p,_) <- packages, keep p, ex <- extra p, fst ex /= "set"])
      where
          addRange :: [(Str, [(Maybe TargetId,a)])] -> [(Str, (TargetId, TargetId))]
          addRange xs = [(a, (minimum' is, maximum' is)) | (a,b) <- xs, let is = mapMaybe fst b, not $ strNull a, is /= []]
  
          weightTag ("set",x) = fromMaybe 0.9 $ lookup x [("stackage",0.0),("haskell-platform",0.1)]
          weightTag ("package",x) = 1
          weightTag ("category",x) = 2
          weightTag ("license",x) = 3
          weightTag _ = 4
  
  
  ---------------------------------------------------------------------
  -- SIMPLE SELECTORS
  
  completionTags :: StoreRead -> [String]
  completionTags store = map BS.unpack $ bstr0Split $ storeRead store Completions
  
  
  ---------------------------------------------------------------------
  -- DATA TYPE, PARSE, PRINT
  
  data Tag = IsExact | IsPackage | IsModule | EqPackage String | EqModule String | EqCategory String String deriving Eq
  
  parseTag :: String -> String -> Maybe Tag
  parseTag k v
      | k ~~ "is" = case () of
          _ | v ~~ "exact" -> Just IsExact
            | v ~~ "package" -> Just IsPackage
            | v ~~ "module" -> Just IsModule
            | otherwise -> Nothing
      | k ~~ "package" = if v == "" then Nothing else Just $ EqPackage v
      | k ~~ "module" = if v == "" then Nothing else Just $ EqModule v
      | v /= "" = Just $ EqCategory k v
      | otherwise = Nothing
      where
          -- make the assumption the first letter always disambiguates
          x ~~ lit = x /= "" && lower x `isPrefixOf` lit
  
  showTag :: Tag -> (String, String)
  showTag IsExact = ("is","exact")
  showTag IsPackage = ("is","package")
  showTag IsModule = ("is","module")
  showTag (EqPackage x) = ("package",x)
  showTag (EqModule x) = ("module",x)
  showTag (EqCategory k v) = (k,v)
  
  
  ---------------------------------------------------------------------
  -- TAG SEMANTICS
  
  -- | Given a tag, find the ranges of identifiers it covers (if it restricts the range)
  -- An empty range means an empty result, while a Nothing means a search on the entire range
  resolveTag :: StoreRead -> Tag -> (Tag, Maybe [(TargetId,TargetId)])
  resolveTag store x = case x of
      IsExact -> (IsExact, Nothing)
      IsPackage -> (IsPackage, Just $ map (dupe . fst) $ V.toList packageIds)
      IsModule -> (IsModule, Just $ map (dupe . fst) $ V.toList moduleIds)
      EqPackage orig@(BS.pack -> val)
          -- look for people who are an exact prefix, sort by remaining length, if there are ties, pick the first one
          | res@(_:_) <- [(BS.length x, (i,x)) | (i,x) <- zipFrom 0 $ bstr0Split packageNames, val `BS.isPrefixOf` x]
              -> let (i,x) = snd $ minimumBy (compare `on` fst) res in (EqPackage $ BS.unpack x, Just [packageIds V.! i])
          | otherwise -> (EqPackage orig , Just [])
      EqModule x -> (EqModule x, Just $ map (moduleIds V.!) $ findIndices (eqModule $ lower x) $ bstr0Split moduleNames)
      EqCategory cat val -> (EqCategory cat val, Just $ concat
          [ V.toList $ jaggedAsk categoryIds i
          | i <- elemIndices (BS.pack (cat ++ ":" ++ val)) $ bstr0Split categoryNames])
      where
          eqModule x | Just x <- stripPrefix "." x, Just x <- stripSuffix "." x = (==) (BS.pack x)
                     | Just x <- stripPrefix "." x = BS.isPrefixOf $ BS.pack x
                     | otherwise = let y = BS.pack x; y2 = BS.pack ('.':x)
                                   in \v -> y `BS.isPrefixOf` v || y2 `BS.isInfixOf` v
  
          (packageNames, packageIds) = storeRead store Packages
          (categoryNames, categoryIds) = storeRead store Categories
          (moduleNames, moduleIds) = storeRead store Modules
  
  
  ---------------------------------------------------------------------
  -- TAG QUERIES
  
  -- | Given a query produce: (refined query, is:exact, filter, enumeration)
  --   You should apply the filter to other peoples results, or if you have nothing else, use the enumeration.
  applyTags :: StoreRead -> [Query] -> ([Query], Bool, TargetId -> Bool, [TargetId])
  applyTags store qs = (qs2, exact, filt, searchTags store qs)
      where (qs2, exact, filt) = filterTags store qs
  
  filterTags :: StoreRead -> [Query] -> ([Query], Bool, TargetId -> Bool)
  filterTags ts qs = (map redo qs, exact, \i -> all ($ i) fs)
      where fs = map (filterTags2 ts . snd) $ groupSort $ map (scopeCategory &&& id) $ filter isQueryScope qs
            exact = Just IsExact `elem` [parseTag a b | QueryScope True a b <- qs]
            redo (QueryScope sense cat val)
                | Just (k,v) <- fmap (showTag . fst . resolveTag ts) $ parseTag cat val = QueryScope sense k v
                | otherwise = QueryNone $ ['-' | not sense] ++ cat ++ ":" ++ val
            redo q = q
  
  
  filterTags2 ts qs = \i -> not (negq i) && (noPosRestrict || posq i)
      where (posq,negq) = both inRanges (pos,neg)
            (pos, neg) = both (concatMap snd) $ partition fst xs
            xs = catMaybes restrictions
            noPosRestrict = all pred restrictions
            restrictions = map getRestriction qs
            pred Nothing = True
            pred (Just (sense, _)) = not sense
            getRestriction :: Query -> Maybe (Bool,[(TargetId, TargetId)])
            getRestriction (QueryScope sense cat val) = do
              tag <- parseTag cat val
              ranges <- snd $ resolveTag ts tag
              pure (sense, ranges)
  
  
  -- | Given a search which has no type or string in it, run the query on the tag bits.
  --   Using for things like IsModule, EqCategory etc.
  searchTags :: StoreRead -> [Query] -> [TargetId]
  searchTags ts qs
      | x:xs <- [map fst $ maybe [] (fromMaybe [] . snd . resolveTag ts) $ parseTag cat val | QueryScope True cat val <- qs]
      = if null xs then x else filter (`Set.member` foldl1' Set.intersection (map Set.fromList xs)) x
  searchTags ts _ = maybe [] (map fst) $ snd $ resolveTag ts IsPackage
  