{-
  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.
-}

{-# LANGUAGE TypeApplications, ApplicativeDo #-}

module Glean.Glass.Pretty.Hack
  ( prettyHackSignature
    -- for testing
  , prettyDecl
  , ByteSpan(..)
  , Decl(..)
  , Name(..)
  , Qual(..)
  , QualName(..)
  , FunctionMod(..)
  , PropertyMod(..)
  , ClassMod(..)
  , MethodMod(..)
  , Abstract(..)
  , Final(..)
  , Visibility(..)
  , Static(..)
  , Async(..)
  , ReadOnly(..)
  , Signature (..)
  , HackType(..)
  , ReturnType(..)
  , ModuleInternal(..)
  , DefaultValue(..)
  , Inout(..)
  , Variadic(..)
  , Parameter(..)
  , Variance(..)
  , Reify(..)
  , TypeParameter(..)
  , Constraint(..)
  , ConstraintKind(..)
  , Container(..)
  , EnumKind(..)
  , EnumConstraint(..)
  , TypeConstKind(..)
  , Transparency(..)
  ) where

import Data.List as List ( foldl' )
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Text (Text)
import Compat.Prettyprinter
import Compat.Prettyprinter.Render.Text (renderStrict)
import qualified Data.Text as Text
import Control.Monad.Extra ( when, whenJust )
import Control.Monad.Trans (MonadTrans(lift))
import Control.Monad.Trans.Maybe (MaybeT (..))
import Control.Monad.Trans.Writer.Strict ( execWriter, tell )
import qualified Data.Map.Strict as Map

import Glean.Glass.SymbolId ( toSymbolId )
import Glean.Glass.Types ( SymbolId(..), RepoName(..) )
import Glean.Glass.Base ( GleanPath(..) )
import Glean.Glass.Path ( fromGleanPath )
import Glean.Util.ToAngle ( ToAngle(toAngle) )
import Glean.Glass.Utils
import qualified Glean.Glass.SymbolId.Hack as Hack

import qualified Glean
import Glean.Angle as Angle
import qualified Glean.Haxl.Repos as Glean
import qualified Glean.Schema.Hack.Types as Hack
import qualified Glean.Schema.Src.Types as Src
import Glean.Schema.CodeHack.Types as Hack
import qualified Glean.Schema.Code.Types as Code
import qualified Glean.Schema.CodemarkupTypes.Types as Code
import qualified Glean.Schema.Codemarkup.Types as Code

-- Pretty-printer annotations for Doc or SimpleDocStream
-- Used to collect xrefs bytespan in pretty-printed signatures
data Ann
  = None
  | BareDecl !Hack.Declaration {- todo: !GleanPath -}
  | SymId !SymbolId

prettyHackSignature
  :: LayoutOptions
  -> RepoName
  -> SymbolId
  -> Hack.Entity
  -> Glean.RepoHaxl u w (Maybe (SimpleDocStream (Maybe SymbolId)))
prettyHackSignature opts repo sym (Hack.Entity_decl d) =
  runMaybeT $ do
    docStream <- layoutSmart opts . prettyDecl opts sym <$> decl d
    let docStreamSymbol = sequence $ reAnnotateS (declToSymbolId repo) docStream
    maybeT $ Just <$> docStreamSymbol
prettyHackSignature _ _ _ Hack.Entity_EMPTY = return Nothing

-- Turn declaration to symbol ids
-- This requires a query to Code.EntityLocation to gather
-- the path to an entity, needed for constructing a SymbolId
declToSymbolId :: RepoName -> Ann -> Glean.RepoHaxl u w (Maybe SymbolId)
declToSymbolId _repo None = return Nothing
declToSymbolId _repo (SymId sym) = return (Just sym)
declToSymbolId repo (BareDecl decl) = runMaybeT $ do
  Code.EntityLocation{..} <- maybeT $ fetchDataRecursive $
    angleEntityLocation entityAngle
  Code.EntityLocation_key{..} <- liftMaybe entityLocation_key
  let Code.Location{..} = entityLocation_key_location
  path <- MaybeT (Just . GleanPath <$> Glean.keyOf location_file)
  MaybeT $ Just <$> toSymbolId (fromGleanPath repo path) entity
  where
    entity = Code.Entity_hack (Hack.Entity_decl decl)
    entityAngle = alt @"hack" (alt @"decl" (toAngle decl))

newtype Name = Name Text
newtype Qual = Qual [Text]
newtype QualName = QualName ([Text], Text)

-- Hack modifier orderings are not as strict as this but since we want
-- to print them in some consistent ordering we enforce the most popular
data FunctionMod = FunctionMod !Async !ModuleInternal
data ClassMod    = ClassMod Abstract Final !ModuleInternal
data MethodMod   =
  MethodMod Abstract Final Visibility Static Async ReadOnly
data PropertyMod   = PropertyMod Abstract Final Visibility Static

data Abstract = Abstract | NotAbstract deriving Eq
data Final = Final | NotFinal deriving Eq
data Visibility = Public | Protected | Private | Internal
data Static = Static | NotStatic deriving Eq
data Async = Async | NotAsync deriving Eq
data ModuleInternal = IsInternal | NotInternal deriving Eq
data ReadOnly = IsReadOnly | NotReadOnly deriving Eq

data ByteSpan = ByteSpan
  { start :: {-# UNPACK #-}!Int
  , length :: {-# UNPACK #-}!Int
  }
type XRefs = [(Hack.Declaration, ByteSpan)]
newtype HackType = HackType { unHackType :: Text }
newtype ReturnType = ReturnType { unReturnType :: Text }
newtype DefaultValue = DefaultValue Text
data Inout = Inout
data Variadic = Variadic
data Parameter
  = Parameter Name HackType (Maybe Inout)
      (Maybe Variadic) (Maybe DefaultValue) ReadOnly XRefs
data Variance = Contravariant | Covariant | Invariant
data Reify = Erased | Reified | SoftReified
data ConstraintKind = As | Equal | Super
data Constraint = Constraint ConstraintKind HackType
data TypeParameter = TypeParameter Name Variance Reify [Constraint] [UserAttr]
data UserAttr = UserAttr Name [Text]
newtype Context = Context { _unContext :: Text }
data Signature = Signature ReadOnly ReturnType [TypeParameter] [Parameter]
  (Maybe [Context]) XRefs
data Container
  = ClassContainer | InterfaceContainer | TraitContainer | EnumContainer
  deriving Eq
data EnumKind = IsClass | Regular
data EnumConstraint = EnumBase HackType | Constrained HackType HackType
data TypeConstKind = IsAbstract | Concrete | PartiallyAbstract
data Transparency = Newtype_ | Type_

data Decl
  = ClassConst Name
  | Enum QualName EnumKind EnumConstraint ModuleInternal
  | Trait QualName [TypeParameter] ModuleInternal
  | Class ClassMod QualName [TypeParameter]
  | Interface QualName [TypeParameter] ModuleInternal
  | Enumerator QualName Name
  | Function FunctionMod QualName Signature
  | GlobalConst QualName
  | Namespace Qual
  | Method MethodMod Container Name Signature
  | Property PropertyMod Container Name HackType
  | TypeConst Name TypeConstKind
  | Typedef QualName [TypeParameter] Transparency ModuleInternal
  | Module Name

prettyDecl :: LayoutOptions -> SymbolId -> Decl -> Doc Ann
prettyDecl _ sym (ClassConst name) =
  "const" <+> annotate (SymId sym) (ppName name)
prettyDecl _ sym (Module name) =
  "module" <+> annotate (SymId sym) (ppName name)

prettyDecl _ sym (Enum name enumKind (EnumBase ty1) internal) =
  ppModuleInternal internal <>
    "enum" <> ppEnumClass enumKind <+>
      annotate (SymId sym) (ppQualName name) <+> ":" <+> ppType ty1
prettyDecl _ sym (Enum name enumKind (Constrained ty1 ty2) internal) =
  ppModuleInternal internal <>
    "enum" <> ppEnumClass enumKind <+>
      annotate (SymId sym) (ppQualName name) <+>
       ":" <+> ppConstraintTypes ty1 ty2

prettyDecl _ sym (Class modifiers name typeParams) =
  ppClassModifiers modifiers <> "class" <+>
    annotate (SymId sym) (ppQualName name) <> ppTypeParams typeParams
prettyDecl _ sym (Interface name typeParams internal) =
  ppModuleInternal internal <> "interface" <+>
    annotate (SymId sym) (ppQualName name) <> ppTypeParams typeParams
prettyDecl _ sym (Trait name typeParams internal) =
  ppModuleInternal internal <> "trait" <+>
    annotate (SymId sym) (ppQualName name) <> ppTypeParams typeParams

prettyDecl _ _sym (Enumerator enum name) =
  ppQualName enum <> "::" <> ppName name

prettyDecl opts sym (Function modifiers name sig) =
  ppSignature opts (ppFunctionModifiers modifiers <+>
    annotate (SymId sym) (ppQualName name)) sig
prettyDecl opts sym (Method modifiers container name sig) =
  ppSignature opts (ppMethodModifiers container modifiers <+>
    annotate (SymId sym) (ppName name)) sig

prettyDecl _ _sym (GlobalConst name) =
  "const" <+> ppQualName name
prettyDecl _ sym (Namespace name) =
  "namespace" <+> annotate (SymId sym) (ppQual name)

prettyDecl _ _ (Property modifiers container name mhacktype) =
  ppPropertyModifiers container modifiers <+> ppType mhacktype <+> ppName name

prettyDecl _ sym (TypeConst name IsAbstract) =
  "abstract" <+> "const" <+> "type" <+> annotate (SymId sym) (ppName name)
prettyDecl _ sym (TypeConst name _) =
  "const" <+> "type" <+> annotate (SymId sym) (ppName name)

prettyDecl _ _sym (Typedef name typeParams Type_ internal) =
  ppModuleInternal internal <>
    "type" <+> ppQualName name <> ppTypeParams typeParams
prettyDecl _ _sym (Typedef name typeParams Newtype_ internal) =
  ppModuleInternal internal <>
    "newtype" <+> ppQualName name <> ppTypeParams typeParams

ppEnumClass :: EnumKind -> Doc Ann
ppEnumClass Regular = emptyDoc
ppEnumClass IsClass = space <> "class"

ppName :: Name -> Doc Ann
ppName (Name n) = pretty n

-- | We never qualify names in generated signatures now
ppQualName :: QualName -> Doc Ann
ppQualName (QualName ([], name)) = pretty name
ppQualName (QualName (_namespace, name)) = pretty name

ppQual :: Qual -> Doc Ann
ppQual (Qual namespace) = concatWith (surround "\\") (pretty <$> namespace)

ppFunctionModifiers :: FunctionMod -> Doc Ann
ppFunctionModifiers (FunctionMod async internal) =
  hcat [ ppModuleInternal internal, ppAsync async, "function" ]

ppClassModifiers :: ClassMod -> Doc Ann
ppClassModifiers (ClassMod abstract final internal) =
  hcat [ ppModuleInternal internal, ppAbstract abstract, ppFinal final ]

ppModuleInternal :: ModuleInternal -> Doc Ann
ppModuleInternal IsInternal = "internal" <> space
ppModuleInternal NotInternal = mempty

ppAsync :: Async -> Doc Ann
ppAsync Async = "async" <> space
ppAsync NotAsync = mempty

ppAbstract :: Abstract -> Doc Ann
ppAbstract Abstract = "abstract" <> space
ppAbstract NotAbstract = mempty

ppFinal :: Final -> Doc Ann
ppFinal Final = "final" <> space
ppFinal NotFinal = mempty

ppReadOnly :: Doc Ann
ppReadOnly = "readonly"

ppSignature :: LayoutOptions -> Doc Ann -> Signature -> Doc Ann
ppSignature
  opts head (Signature readOnly returnType typeParams params ctxs xrefs) =
    if fitsOnOneLine then onelineSig else multilineSig
  where
    onelineTypeParams = if null typeParams then emptyDoc else cat
      [ "<"
      , sep $ punctuate "," (map ppTypeParam typeParams)
      , ">"
      ]
    onelineArgs = if null params then "()" else
      parens (hsep $ punctuate comma (map ppParameter params))
    onelineSig = nest 4 $ head <> fillCat
      [ onelineTypeParams
      , onelineArgs
      , ppContexts ctxs
      , ":" <> readOnlyKwd <+> ppReturnType returnType xrefs
      ]
    multilineTypeParams = if null typeParams then emptyDoc else vcat
        [ nest 4 $ vcat
          [ "<"
          , vcat $ map ((<> ",") . ppTypeParam) typeParams
          ]
        , ">"
        ]
    multilineArgs = vcat
      [ nest 4 (vcat $
        "("
        : map ((<> ",") . ppParameter) params
        )
      , ")"
      ]
    multilineSig = head
      <> multilineTypeParams
      <> multilineArgs
      <> nest 4 (
        ppContexts ctxs
        <> ":"
        <> readOnlyKwd
        <+> ppReturnType returnType xrefs
      )
    paramsText = renderStrict $ layoutSmart opts onelineSig
    fitsOnOneLine = not containsNewline
    containsNewline = Text.any (== '\n') paramsText
    readOnlyKwd = case readOnly of
      IsReadOnly -> space <> ppReadOnly
      NotReadOnly -> ""

ppTypeParams :: [TypeParameter] -> Doc Ann
ppTypeParams typeParams | null typeParams = emptyDoc
ppTypeParams typeParams = cat
  [ nest 4 $ cat
    [ "<", sep $ punctuate "," (map ppTypeParam typeParams)]
  , ">"
  ]

--
-- Lots of interesting syntax for type parameters
-- https://docs.hhvm.com/hack/generics/introduction
--
ppTypeParam :: TypeParameter -> Doc Ann
ppTypeParam (TypeParameter name variance reify constraints userAttrs) = hcat
  [ ppAttrs userAttrs -- attributes
  , ppReified reify -- reify keyword
  , ppVariance variance -- then the variance markers
  , ppName name -- then the type param name
  , hsep (map ppConstraint constraints) -- and any constraints
  ]

-- User attributes on type parameters, including the reification attributes
ppAttrs :: [UserAttr] -> Doc Ann
ppAttrs attrs = case attrs of
  [] -> emptyDoc
  _ -> hcat ["<<", hsep (punctuate comma (map ppAttr attrs)), ">> "]

-- https://docs.hhvm.com/hack/attributes/introduction
ppAttr :: UserAttr -> Doc Ann
-- e.g. __Memoize
ppAttr (UserAttr name []) = ppName name
-- __Deprecated("foo")
-- <<Contributors("John Doe", keyset["ORM Team", "Core Library Team"])>>
ppAttr (UserAttr name args)
  = ppName name <>
      parens (hsep (punctuate comma (map pretty args)))

-- Reified generics
-- https://docs.hhvm.com/hack/reified-generics/reified-generics
ppReified :: Reify -> Doc Ann
ppReified SoftReified = "reify "
ppReified Reified = "reify "
ppReified _ = emptyDoc

--
-- Variance markers on type parameters
-- See https://docs.hhvm.com/hack/generics/variance
--
ppVariance :: Variance -> Doc Ann
ppVariance Covariant = "+"
ppVariance Contravariant = "-"
ppVariance _ = emptyDoc

--
-- Generic type parameter constraint syntax
-- See https://docs.hhvm.com/hack/generics/type-constraints
--
ppConstraint :: Constraint -> Doc Ann
ppConstraint (Constraint kind ty) = hcat
  [ case kind of
      Equal -> " = "
      As -> " as "
      Super -> " super "
  , ppType ty
  ]

ppTypeXRefs :: HackType -> XRefs -> Doc Ann
ppTypeXRefs (HackType t) xrefs =
  let spans = fmap (\(ann, ByteSpan{..}) -> (ann, start, length)) xrefs
      fragments = splitString t spans in
  mconcat $ (\(frag, ann) -> annotate (toAnn ann) $ pretty frag) <$> fragments
  where
    toAnn Nothing = None
    toAnn (Just decl) = BareDecl decl

ppType :: HackType -> Doc Ann
ppType (HackType t) = pretty t

ppReturnType :: ReturnType -> XRefs -> Doc Ann
ppReturnType (ReturnType t) xrefs = ppTypeXRefs (HackType t) xrefs

ppParameter :: Parameter -> Doc Ann
ppParameter (Parameter name typeName inout variadic defaultValue readOnly xrefs)
  = nest 4 $ sep $ execWriter $ do
    when (readOnly == IsReadOnly) $ tell [ppReadOnly]
    whenJust inout $ tell . ppInout
    tell [ppTypeXRefs typeName xrefs]
    case variadic of
      Just Variadic -> tell [hcat ["...", ppName name]]
      Nothing ->  tell [ppName name]
    whenJust defaultValue $ tell . pure . ppDefaultValue typeName

-- Contexts can be parameterised, empty, missing. or a simple list
-- https://docs.hhvm.com/hack/contexts-and-capabilities/introduction
ppContexts :: Maybe [Context] -> Doc Ann
ppContexts Nothing = emptyDoc
ppContexts (Just []) = brackets emptyDoc
ppContexts (Just ctxs) = brackets $ hsep (punctuate comma (map ppContext ctxs))

ppContext :: Context -> Doc Ann
ppContext (Context ctx) = pretty ctx

ppDefaultValue :: HackType -> DefaultValue -> Doc Ann
ppDefaultValue typeName (DefaultValue v) = "=" <+>
  case typeName of -- work around for type-sensitive quoting
    HackType ty
      | ty `elem` ["string", "?string"], v /= "null" -> squotes (pretty v)
    _ -> pretty v

ppInout :: Inout -> [Doc Ann]
ppInout Inout = ["inout"]

ppConstraintTypes :: HackType -> HackType -> Doc Ann
ppConstraintTypes ty1 ty2 = ppType ty1 <+> "as" <+> ppType ty2

ppMethodModifiers :: Container -> MethodMod -> Doc Ann
ppMethodModifiers container
  (MethodMod abstract final visibility static async readonlyThis) =
  fillSep $ execWriter $ do
    when
      (  abstract == Abstract
      && container /= InterfaceContainer
      ) $ tell ["abstract"]
    when (final==Final) $ tell ["final"]
    tell $ pure $ case visibility of
      Public -> "public"
      Protected -> "protected"
      Private -> "private"
      Internal -> "internal"
    when (static==Static) $ tell ["static"]
    when (readonlyThis==IsReadOnly) $ tell ["readonly"]
    when (async==Async) $ tell ["async"]
    tell ["function"]

ppPropertyModifiers :: Container -> PropertyMod -> Doc Ann
ppPropertyModifiers container (PropertyMod abstract final visibility static) =
  fillSep $ execWriter $ do
    when
      (  abstract == Abstract
      && container /= InterfaceContainer
      ) $ tell ["abstract"]
    when (final==Final) $ tell ["final"]
    tell $ pure $ case visibility of
      Public -> "public"
      Protected -> "protected"
      Private -> "private"
      Internal -> "internal"
    when (static==Static) $ tell ["static"]

--
-- Process the raw declaration result from Glean to build up a cleaner
-- `Decl` description of the type signature, possibly pulling in some related
-- information as we go
--
decl :: Hack.Declaration -> Glean.MaybeTRepoHaxl u w Decl
decl (Hack.Declaration_classConst Hack.ClassConstDeclaration{..}) = do
  Hack.ClassConstDeclaration_key{..} <- liftMaybe classConstDeclaration_key
  name <- liftMaybe $ Hack.name_key classConstDeclaration_key_name
  pure $ ClassConst $ Name name
decl (Hack.Declaration_container container) = containerDecl container
decl (Hack.Declaration_enumerator Hack.Enumerator{..}) = do
  Hack.Enumerator_key{..} <- liftMaybe enumerator_key
  Hack.EnumDeclaration{..} <- pure enumerator_key_enumeration
  Hack.EnumDeclaration_key{..} <- liftMaybe enumDeclaration_key
  enum <- qName enumDeclaration_key_name
  name <- liftMaybe $ Hack.name_key enumerator_key_name
  pure $ Enumerator (QualName enum) $ Name name
decl (Hack.Declaration_function_ decl@Hack.FunctionDeclaration{..}) = do
  Hack.FunctionDeclaration_key{..} <- liftMaybe functionDeclaration_key
  Hack.FunctionDefinition{..} <- maybeT $ fetchDataRecursive $
    angleFunctionDefinition (Angle.factId (Glean.getId decl))
  name <- qName functionDeclaration_key_name
  def <- liftMaybe functionDefinition_key
  let typeParams = Hack.functionDefinition_key_typeParams def
  let sign = Hack.functionDefinition_key_signature def
  pure $ Function (modifiersForFunction def) (QualName name)
    (toSignature typeParams sign (Hack.functionDefinition_key_readonlyRet def))
decl (Hack.Declaration_module Hack.ModuleDeclaration{..}) = do
  Hack.ModuleDeclaration_key{..} <- liftMaybe moduleDeclaration_key
  name <- liftMaybe $ Hack.name_key moduleDeclaration_key_name
  pure $ Module $ Name name
decl (Hack.Declaration_globalConst Hack.GlobalConstDeclaration{..}) = do
  Hack.GlobalConstDeclaration_key{..} <- liftMaybe globalConstDeclaration_key
  name <- qName globalConstDeclaration_key_name
  pure $ GlobalConst $ QualName name
decl (Hack.Declaration_namespace_ Hack.NamespaceDeclaration{..}) = do
  Hack.NamespaceDeclaration_key{..} <- liftMaybe namespaceDeclaration_key
  name <- namespaceQName $ Just namespaceDeclaration_key_name
  pure $ Namespace $ Qual name
decl (Hack.Declaration_method decl@Hack.MethodDeclaration{..}) = do
  Hack.MethodDeclaration_key{..} <- liftMaybe methodDeclaration_key
  Hack.MethodDefinition{..} <- maybeT $ fetchDataRecursive $
    angleMethodDefinition (Angle.factId (Glean.getId decl))
  name <- liftMaybe $ Hack.name_key methodDeclaration_key_name
  def <- liftMaybe methodDefinition_key
  let typeParams = Hack.methodDefinition_key_typeParams def
  let sig = Hack.methodDefinition_key_signature def
  let container = containerKind methodDeclaration_key_container
  pure $ Method (modifiersForMethod def) container (Name name)
    (toSignature typeParams sig (Hack.methodDefinition_key_readonlyRet def))
decl (Hack.Declaration_property_ prop@Hack.PropertyDeclaration{..}) = do
  Hack.PropertyDeclaration_key{..} <- liftMaybe propertyDeclaration_key
  Hack.PropertyDefinition{..} <- maybeT $ fetchDataRecursive $
    predicate @Hack.PropertyDefinition $
      rec $
        field @"declaration"
          (Angle.asPredicate $ Angle.factId $ Glean.getId prop)
      end
  def <- liftMaybe propertyDefinition_key
  let type_ = typeInfoToType $ Hack.propertyDefinition_key_typeInfo def
  name <- liftMaybe $ Hack.name_key propertyDeclaration_key_name
  let container = containerKind propertyDeclaration_key_container
  pure $ Property (modifiersForProperty def) container (Name name) type_
decl (Hack.Declaration_typeConst decl@Hack.TypeConstDeclaration{..}) = do
  Hack.TypeConstDeclaration_key{..} <- liftMaybe typeConstDeclaration_key
  hackTypeConstKind <- maybeT $ fetchData $
    angleTypeConstDefinition (Angle.factId (Glean.getId decl))
  let typeConstKind = case hackTypeConstKind of
        Hack.TypeConstKind_Abstract -> IsAbstract
        Hack.TypeConstKind_Concrete -> Concrete
        Hack.TypeConstKind_PartiallyAbstract -> PartiallyAbstract
        Hack.TypeConstKind__UNKNOWN{} -> error "unexpected typeconst kind"
  name <- liftMaybe $ Hack.name_key typeConstDeclaration_key_name
  pure $ TypeConst (Name name) typeConstKind
decl (Hack.Declaration_typedef_ decl@Hack.TypedefDeclaration{..}) = do
  Hack.TypedefDeclaration_key{..} <- liftMaybe typedefDeclaration_key
  (typedefTypeParams, isTransparent, moduleMembership) <- maybeT $
    fetchDataRecursive $
      angleTypedefDefinition (Angle.factId (Glean.getId decl))
  name <- qName typedefDeclaration_key_name
  let typeParams = map toTypeParameter typedefTypeParams
      isNewtype = if isTransparent then Type_ else Newtype_
  pure $ Typedef (QualName name) typeParams isNewtype
    (toModuleVisibility moduleMembership)
decl Hack.Declaration_EMPTY = MaybeT (return Nothing)

containerDecl :: Hack.ContainerDeclaration -> Glean.MaybeTRepoHaxl u w Decl
containerDecl (Hack.ContainerDeclaration_enum_
      decl@Hack.EnumDeclaration{..}) = do
    Hack.EnumDeclaration_key{..} <- liftMaybe enumDeclaration_key
    (enumBaseTypeInfo,enumConstraintTypeInfo,isClass,moduleInfo) <- maybeT $
      fetchDataRecursive $ angleEnumDefinition (Angle.factId (Glean.getId decl))
    let enumKind = if isClass then IsClass else Regular
    let baseType = typeInfoToType enumBaseTypeInfo
    let constraint =  case enumConstraintTypeInfo of
          Nothing -> EnumBase baseType
          Just ty -> Constrained baseType (typeInfoToType (Just ty))
    name <- qName enumDeclaration_key_name
    pure $ Enum (QualName name) enumKind constraint
      (toModuleVisibility moduleInfo)
containerDecl
  (Hack.ContainerDeclaration_trait decl@Hack.TraitDeclaration{..}) = do
    Hack.TraitDeclaration_key{..} <- liftMaybe traitDeclaration_key
    (traitTypeParams, moduleInfo) <- maybeT $ fetchDataRecursive $
      angleTraitDefinition (Angle.factId (Glean.getId decl))
    name <- qName traitDeclaration_key_name
    let typeParams = map toTypeParameter traitTypeParams
    pure $ Trait (QualName name) typeParams (toModuleVisibility moduleInfo)
containerDecl
  (Hack.ContainerDeclaration_class_ decl@Hack.ClassDeclaration{..}) = do
    Hack.ClassDeclaration_key{..} <- liftMaybe classDeclaration_key
    (isAbstract, isFinal, classTypeParams, moduleInfo) <- maybeT $
      fetchDataRecursive $ angleClassDefinition
        (Angle.factId (Glean.getId decl))
    name <- qName classDeclaration_key_name
    let typeParams = map toTypeParameter classTypeParams
    pure $ Class (modifiersForClass isAbstract isFinal
             (toModuleVisibility moduleInfo))
       (QualName name) typeParams
containerDecl
  (Hack.ContainerDeclaration_interface_ decl@Hack.InterfaceDeclaration{..}) = do
    Hack.InterfaceDeclaration_key{..} <- liftMaybe interfaceDeclaration_key
    (interTypeParams, moduleInfo) <- maybeT $ fetchDataRecursive $
      angleInterfaceDefinition (Angle.factId (Glean.getId decl))
    name <- qName interfaceDeclaration_key_name
    let typeParams = map toTypeParameter interTypeParams
    pure $ Interface (QualName name) typeParams (toModuleVisibility moduleInfo)
containerDecl Hack.ContainerDeclaration_EMPTY = MaybeT (return Nothing)

containerKind
  :: Hack.ContainerDeclaration -> Container
containerKind Hack.ContainerDeclaration_enum_ {} = EnumContainer
containerKind Hack.ContainerDeclaration_trait {} = TraitContainer
containerKind Hack.ContainerDeclaration_class_ {} = ClassContainer
containerKind Hack.ContainerDeclaration_interface_ {} = InterfaceContainer
containerKind Hack.ContainerDeclaration_EMPTY = ClassContainer

qName :: Hack.QName -> Glean.MaybeTRepoHaxl u w ([Text], Text)
qName Hack.QName{..} = do
 Hack.QName_key{..} <- liftMaybe qName_key
 namespace <- namespaceQName qName_key_namespace_
 name <- liftMaybe $ Hack.name_key qName_key_name
 return (namespace, name)

namespaceQName :: Maybe Hack.NamespaceQName -> Glean.MaybeTRepoHaxl u w [Text]
namespaceQName nsqname = go nsqname []
  where
    go Nothing acc = return acc
    go (Just nsqname@Hack.NamespaceQName{..}) acc = do
      mshortname <- lift $ shortenGlobalAlias nsqname
      case mshortname of -- if this one is global alias, we're done.
        Just name -> return (name : acc)
        Nothing -> do -- else collect name and try parent
          Hack.NamespaceQName_key{..} <- liftMaybe namespaceQName_key
          name <- liftMaybe $ Hack.name_key namespaceQName_key_name
          go namespaceQName_key_parent (name : acc)

-- in a (recursive) hack.NamespaceQName, occurences of global namespace
-- aliases should be shortened wherever they occur.
shortenGlobalAlias :: Hack.NamespaceQName -> Glean.RepoHaxl u w (Maybe Text)
shortenGlobalAlias nsqname = Map.lookup (Glean.getId nsqname) <$>
  Hack.hackGlobalNamespaceAliases

modifiersForFunction :: Hack.FunctionDefinition_key -> FunctionMod
modifiersForFunction Hack.FunctionDefinition_key{..} =
  FunctionMod asyncMod visibility
  where
    asyncMod = if functionDefinition_key_isAsync then Async else NotAsync
    visibility = toModuleVisibility functionDefinition_key_module_

toModuleVisibility :: Maybe Hack.ModuleMembership -> ModuleInternal
toModuleVisibility (Just (Hack.ModuleMembership _ True)) = IsInternal
toModuleVisibility _ = NotInternal

modifiersForClass :: Bool -> Bool -> ModuleInternal -> ClassMod
modifiersForClass isAbstract isFinal internal = ClassMod
  (if isAbstract then Abstract else NotAbstract)
  (if isFinal then Final else NotFinal)
  internal

modifiersForMethod :: Hack.MethodDefinition_key -> MethodMod
modifiersForMethod Hack.MethodDefinition_key {..} =
  MethodMod
  (if methodDefinition_key_isAbstract then Abstract else NotAbstract)
  (if methodDefinition_key_isFinal then Final else NotFinal)
  (fromHackVisibility methodDefinition_key_visibility)
  (if methodDefinition_key_isStatic then Static else NotStatic)
  (if methodDefinition_key_isAsync then Async else NotAsync)
  (if methodDefinition_key_isReadonlyThis == Just True
     then IsReadOnly else NotReadOnly)

modifiersForProperty :: Hack.PropertyDefinition_key -> PropertyMod
modifiersForProperty Hack.PropertyDefinition_key {..} =
  PropertyMod
  (if propertyDefinition_key_isAbstract then Abstract else NotAbstract)
  (if propertyDefinition_key_isFinal then Final else NotFinal)
  (fromHackVisibility propertyDefinition_key_visibility)
  (if propertyDefinition_key_isStatic then Static else NotStatic)

fromHackVisibility :: Hack.Visibility  -> Visibility
fromHackVisibility v = case v of
  Hack.Visibility_Public -> Public
  Hack.Visibility_Protected -> Protected
  Hack.Visibility_Private -> Private
  Hack.Visibility_Internal -> Internal
  Hack.Visibility__UNKNOWN{} -> error "unexpected visibility"

-- Glass-side implementation of fbcode/glean/rts/prim.cpp:relSpansToAbs
relSpansToAbs :: [Src.RelByteSpan] -> [ByteSpan]
relSpansToAbs byteSpans = snd $ List.foldl' f (0, []) byteSpans
  where
    f (!start, acc) (Src.RelByteSpan offset length) =
      let off = fromIntegral (Glean.fromNat offset)
          len = fromIntegral (Glean.fromNat length)
          start' = start + off
      in (start', ByteSpan start' len : acc)

-- Extracts type and xrefs from a TypeInfo
-- XRefs are converted from relative spans (Glean representation)
-- to absolute (Glass representation)
-- If TypeInfo doesn't exist, returned type is overridden by provided
-- default.
toTypeAndXRefs :: Maybe Hack.TypeInfo -> (HackType, XRefs)
toTypeAndXRefs typeInfo = case typeInfo of
  (Just (Hack.TypeInfo _ (Just (Hack.TypeInfo_key displayType hackXRefs _)))) ->
    let f (Hack.XRef declaration ranges) = case declaration of
          Hack.XRefTarget_declaration decl ->
            Just ((\x -> (decl, x)) <$> relSpansToAbs ranges)
          _ -> Nothing
        xrefs = concat (mapMaybe f hackXRefs)
    in (toType $ Just displayType, xrefs)

  _ -> (toType Nothing, [])

toSignature ::
  [Hack.TypeParameter] -> Hack.Signature -> Maybe Hack.ReadonlyKind -> Signature
toSignature typeParams Hack.Signature{..} mbReadOnly = case signature_key of
  Nothing -> Signature NotReadOnly (ReturnType unknownType) [] [] Nothing []
  Just (Hack.Signature_key _ params mctxs retTypeInfo) ->
   let (type_, xrefs) = toTypeAndXRefs retTypeInfo
       readOnly = case mbReadOnly of
         Just _ -> IsReadOnly
         Nothing -> NotReadOnly
   in Signature
        readOnly
        (ReturnType (unHackType type_))
        (map toTypeParameter typeParams)
        (map toParameter params)
        (map toContext <$> mctxs)
        -- Maybe [] is used to distinguish default context from literal "[]"
        xrefs

toType :: Maybe Hack.Type -> HackType
toType Nothing = HackType unknownType
toType (Just (Hack.Type _ mkey)) = HackType $ fromMaybe unknownType mkey

toTypeParameter :: Hack.TypeParameter -> TypeParameter
toTypeParameter
  (Hack.TypeParameter name variance reifyKind constraints attributes) =
    TypeParameter
    (toName name)
    (toVariance variance)
    (toReifyKind reifyKind)
    (map toConstraint constraints)
    (mapMaybe toAttribute attributes)

toAttribute :: Hack.UserAttribute -> Maybe UserAttr
toAttribute (Hack.UserAttribute _ Nothing) = Nothing
toAttribute (Hack.UserAttribute _ (Just
    (Hack.UserAttribute_key name params _))) =
  Just $ UserAttr (toName name) params

toContext :: Hack.Context_ -> Context
toContext (Hack.Context_ _ Nothing) = Context unknownType
toContext (Hack.Context_ _ (Just ctx)) = Context ctx'
  where
    -- There are only a few dozen contexts in use.
    -- Gronky auto-imported handling hack to get a short name
    --
    -- > [\HH\Contexts\leak_safe] -> [leak_safe]
    --
    -- If we switch to proper declarations and auto-import tables we can avoid
    -- the string handling here.
    ctx' | Just tidy <- Text.stripPrefix "HH\\Contexts\\" ctx = tidy
         | Just tidy <- Text.stripPrefix "\\HH\\Contexts\\" ctx = tidy
         | otherwise = ctx

toVariance :: Hack.Variance -> Variance
toVariance Hack.Variance_Invariant = Invariant
toVariance Hack.Variance_Contravariant = Contravariant
toVariance Hack.Variance_Covariant = Covariant
toVariance (Hack.Variance__UNKNOWN _) = Invariant

toReifyKind :: Hack.ReifyKind -> Reify
toReifyKind Hack.ReifyKind_Reified = Reified
toReifyKind Hack.ReifyKind_SoftReified = SoftReified
toReifyKind Hack.ReifyKind_Erased = Erased
toReifyKind (Hack.ReifyKind__UNKNOWN _) = Erased

typeInfoToType :: Maybe Hack.TypeInfo -> HackType
typeInfoToType typeInfo =
  toType $ case typeInfo of
        (Just (Hack.TypeInfo _ (Just (Hack.TypeInfo_key displayType _ _)))) ->
          Just displayType
        _ -> Nothing

toConstraint :: Hack.Constraint -> Constraint
toConstraint (Hack.Constraint kind _ typeInfo) =
  Constraint (toConstraintKind kind) (typeInfoToType typeInfo)

toConstraintKind :: Hack.ConstraintKind -> ConstraintKind
toConstraintKind Hack.ConstraintKind_Equal = Equal
toConstraintKind Hack.ConstraintKind_As = As
toConstraintKind Hack.ConstraintKind_Super = Super
toConstraintKind (Hack.ConstraintKind__UNKNOWN _) = Equal

toParameter :: Hack.Parameter -> Parameter
toParameter
  (Hack.Parameter name _ inout variadic mdefaultValue _ typeInfo readOnly) =
  let (type_, xrefs) = toTypeAndXRefs typeInfo
  in Parameter
      (toName name)
      (HackType (unHackType type_))
      (if inout then Just Inout else Nothing)
      (if variadic then Just Variadic else Nothing)
      (DefaultValue <$> mdefaultValue)
      (maybe NotReadOnly (const IsReadOnly) readOnly)
      xrefs

toName :: Hack.Name -> Name
toName (Hack.Name _ mkey) = Name $ fromMaybe "(anonymous)" mkey

unknownType :: Text
unknownType = "<unknown-type>"

angleClassDefinition
  :: Angle Hack.ClassDeclaration
  -> Angle (Bool, Bool, [Hack.TypeParameter], Maybe Hack.ModuleMembership )
angleClassDefinition decl = vars $ \isAbstract isFinal typeParams moduleInfo ->
  tuple (isAbstract, isFinal, typeParams, moduleInfo) `where_` [
    wild .= predicate @Hack.ClassDefinition (
      rec $
        field @"declaration" (Angle.asPredicate decl) $
        field @"isAbstract" isAbstract $
        field @"isFinal" isFinal $
        field @"typeParams" typeParams $
        field @"module_" moduleInfo
      end)
  ]

angleTraitDefinition
  :: Angle Hack.TraitDeclaration
  -> Angle ([Hack.TypeParameter], Maybe Hack.ModuleMembership)
angleTraitDefinition decl = vars $ \typeParams modInfo ->
  tuple (typeParams, modInfo) `where_` [
    wild .= predicate @Hack.TraitDefinition (
      rec $
        field @"declaration" (Angle.asPredicate decl) $
        field @"typeParams" typeParams $
        field @"module_" modInfo
      end)
  ]

angleInterfaceDefinition
  :: Angle Hack.InterfaceDeclaration
  -> Angle ([Hack.TypeParameter], Maybe Hack.ModuleMembership)
angleInterfaceDefinition decl = vars $ \typeParams modInfo ->
  tuple (typeParams, modInfo) `where_` [
    wild .= predicate @Hack.InterfaceDefinition (
      rec $
        field @"declaration" (Angle.asPredicate decl) $
        field @"typeParams" typeParams $
        field @"module_" modInfo
      end)
  ]

angleTypedefDefinition
  :: Angle Hack.TypedefDeclaration
  -> Angle ([Hack.TypeParameter], Bool, Maybe Hack.ModuleMembership)
angleTypedefDefinition decl = vars $ \typeParams transparency moduleInfo ->
  tuple (typeParams, transparency, moduleInfo) `where_` [
    wild .= predicate @Hack.TypedefDefinition (
      rec $
        field @"declaration" (Angle.asPredicate decl) $
        field @"typeParams" typeParams $
        field @"isTransparent" transparency $
        field @"module_" moduleInfo
      end)
  ]

angleTypeConstDefinition
  :: Angle Hack.TypeConstDeclaration -> Angle Hack.TypeConstKind
angleTypeConstDefinition decl = var $ \typeConstKind ->
  typeConstKind `where_` [
    wild .= predicate @Hack.TypeConstDefinition (
      rec $
        field @"declaration" (Angle.asPredicate decl) $
        field @"kind" typeConstKind
      end)
  ]

-- hack enums: need to distinguish `enum T : Z` , or `enum class T : X as Y`
angleEnumDefinition
  :: Angle Hack.EnumDeclaration
  -> Angle (Maybe Hack.TypeInfo, Maybe Hack.TypeInfo, Bool,
            Maybe Hack.ModuleMembership)
angleEnumDefinition decl = vars $ \(baseType :: Angle (Maybe Hack.TypeInfo))
    asType isEnumClass modInfo ->
  tuple (baseType, asType, isEnumClass, modInfo ) `where_` [
    wild .= predicate @Hack.EnumDefinition (
      rec $
        field @"declaration" (Angle.asPredicate decl) $
        field @"enumBaseTypeInfo" baseType $
        field @"enumConstraintTypeInfo" asType $
        field @"isEnumClass" isEnumClass $
        field @"module_" modInfo
      end)
  ]

angleMethodDefinition
  :: Angle Hack.MethodDeclaration -> Angle Hack.MethodDefinition
angleMethodDefinition decl = predicate @Hack.MethodDefinition $
  rec $
    field @"declaration" (Angle.asPredicate decl)
  end

angleFunctionDefinition
  :: Angle Hack.FunctionDeclaration -> Angle Hack.FunctionDefinition
angleFunctionDefinition decl = predicate @Hack.FunctionDefinition $
  rec $
    field @"declaration" (Angle.asPredicate decl)
  end

angleEntityLocation
  :: Angle Code.Entity -> Angle Code.EntityLocation
angleEntityLocation ent =
  predicate @Code.EntityLocation $
    rec $
      field @"entity" ent
    end