content: {-
    Copyright (c) Meta Platforms, Inc. and affiliates.
    All rights reserved.
  
    This source code is licensed under the BSD-style license found in the
    LICENSE file in the root directory of this source tree.
  -}
  
  {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
  module Glean.Util.CxxXRef
    ( transformXRefs
    ) where
  
  import Control.Monad
  import Data.List
  import Text.JSON
  
  data XRef = XRef !Int !Int JSValue
  
  order :: XRef -> XRef -> Ordering
  order (XRef o1 n1 v1) (XRef o2 n2 v2) =
    compare o1 o2 <> compare n2 n1 <> compare v1 v2
  
  -- | Process a `cxx1.FileXRefs` (as JSON) into a flat list of absolute
  -- offsets, which is more useful for inspecting and comparing.  This
  -- is used by regression tests and the special "xref" query in the
  -- shell.
  transformXRefs :: JSValue -> Result JSValue
  transformXRefs v = do
    [ ("xmap", xmap), ("targets", JSArray targets) ] <- keyVals v
    [ ("file", file),
      ("fixed", JSArray fixed),
      ("froms", JSArray froms) ] <- keyVals xmap
    fixed_xrefs <- forM fixed $ \x -> do
      [ ("target", target), ("from", from) ] <- objVals x
      spans <- fromToByteSpans from
      return [ XRef o n target | (o, n) <- spans ]
    when (length froms /= length targets) $ fail "invalid xrefs"
    variable_xrefs <- forM (zip targets froms) $ \(t, from) -> do
      JSObject xrefs <- return t
      JSArray ts <- valFromObj "key" xrefs
      spans <- fromToByteSpans from
      return [ XRef o n t | (o, n) <- spans, t <- ts ]
    return $ makeObj
      [ ("key", JSObject $ toJSObject
          [ ("file", file)
          , ("xrefs", JSArray
              $ map toXRef
              $ sortBy order
              $ concat
              $ variable_xrefs ++ fixed_xrefs)
          ])
      ]
    where
      fromToByteSpans from = do
        [ ("spans", JSArray packedSpans),
          ("expansions", JSArray packedExpansions),
          ("spellings", JSArray packedSpellings) ] <- objVals from
        spans <- unpackByteSpans packedSpans
        expansions <- unpackByteSpans packedExpansions
        spellings <- unpackByteSpans packedSpellings
        return $ sort $ spans ++ expansions ++ spellings
  
      unpackByteSpans packedByteSpans = do
        relByteSpans <- mapM toRelByteSpans packedByteSpans
        return $ reoffset 0 (concat relByteSpans)
        where
        toRelByteSpans x = do
          [("length", JSRational _ n), ("offsets", JSArray offsets)] <- objVals x
          return $ map ((, floor n) . (\(JSRational _ o) -> floor o)) offsets
  
      toXRef (XRef o n t) = makeObj
        [ ("range", makeObj
            [ ("begin", showJSON o)
            , ("end", showJSON n)
            ]),
          ("target", t)
        ]
  
      reoffset !_ [] = []
      reoffset !k ((o, n) : xs) = (o+k, o+k+n) : reoffset (o+k) xs
  
      objVals :: JSValue -> Result [(String, JSValue)]
      objVals (JSObject obj) = return $ fromJSObject obj
      objVals _ = fail "not an object"
  
      keyVals :: JSValue -> Result [(String, JSValue)]
      keyVals (JSObject obj) = objVals =<< valFromObj "key" obj
      keyVals _ = fail "not an object"
  