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.
  -}
  
  {-# LANGUAGE DeriveTraversable #-}
  {-# LANGUAGE UnboxedTuples #-}
  
  module Glean.RTS.Types
    ( -- * fact types
      -- ** type
      Id
      -- ** newtype
    , Fid(..), invalidFid, lowestFid
      -- ** phantom type
    , Pid(..), invalidPid, lowestPid
      -- * Types
    , Type
    , Glean.RTS.Types.FieldDef
    , PidRef(..)
    , ExpandedType(..)
    , repType
    , sumLike
    , eqType
    , derefType
      -- ** Representation types
    , Rep(..)
  ) where
  
  import Control.DeepSeq
  import Data.Hashable
  import qualified Data.Text as Text
  import Compat.Prettyprinter
  import Data.Vector.Primitive (Prim)
  import Foreign
  
  import Glean.Types (Id, fIRST_FREE_ID)
  import Glean.Angle.Types hiding (Type)
  import Glean.Display
  import Glean.Schema.Util
  
  -- | 'Pid' holds the glean Id corresponding to the definition of a predicate.
  --
  -- As a Fid that Id points to the glean fact that holds the predicate name and
  -- key type and value type).
  --
  -- Querying for this Id (as prefix of key) gives all facts for this predicate.
  newtype Pid = Pid { fromPid :: Int64 }
    deriving(Eq,Ord,Enum,Hashable,Storable,Show,NFData,Prim)
  
  instance Pretty Pid where
    pretty (Pid n) = "{" <> pretty n <> "}"
  
  instance Display Pid where
    display _ = pretty
  
  invalidPid :: Pid
  invalidPid = Pid 0
  
  lowestPid :: Pid
  lowestPid = Pid fIRST_FREE_ID
  
  -- | Id of a fact that points to an entry in the database.
  -- If this entry happens to be a predicate definition then this
  -- is also logically a Pid.  If this entry is fact about some
  -- predicate 'p' then this is also logically an 'IdOf p'.
  newtype Fid = Fid { fromFid :: Id }
    deriving(Eq,Ord,Enum,Hashable,Storable,Show,NFData,Prim)
  
  instance Pretty Fid where
    pretty (Fid n) = "{" <> pretty n <> "}"
  
  instance Display Fid where
    display _ = pretty
  
  invalidFid :: Fid
  invalidFid = Fid 0
  
  lowestFid :: Fid
  lowestFid = Fid fIRST_FREE_ID
  
  -- -----------------------------------------------------------------------------
  -- Runtime types
  
  data PidRef = PidRef Pid PredicateId
    deriving Show
  
  instance Eq PidRef where
    PidRef a _ == PidRef b _ = a == b
  
  instance Ord PidRef where
    compare (PidRef a _) (PidRef b _) = compare a b
  
  instance Display PidRef where
    display opts (PidRef _ ref) = display opts ref
      -- we could add an option to display the Pids too
  
  data ExpandedType = ExpandedType TypeId Type
    deriving (Show, Eq)
  
  instance Display ExpandedType where
    display opts (ExpandedType ref _) = display opts ref
  
  type Type = Type_ () PidRef ExpandedType
  type FieldDef = FieldDef_ () PidRef ExpandedType
  
  
  -- | Construct the representation of a Type
  repType :: Type -> Rep Pid
  repType ByteTy = ByteRep
  repType NatTy = NatRep
  repType StringTy = StringRep
  repType (ArrayTy ty) = ArrayRep (repType ty)
  repType (RecordTy fields) =
    TupleRep [ repType ty | FieldDef _ ty <- fields ]
  repType (SumTy fields) =
    SumRep [ repType ty | FieldDef _ ty <- fields ]
  repType (SetTy ty)  = SetRep (repType ty)
  repType (PredicateTy _ (PidRef pid _)) = PredicateRep pid
  repType (NamedTy _ (ExpandedType _ ty)) = repType ty
  repType (MaybeTy ty) = repType (lowerMaybe ty)
  repType (EnumeratedTy names) = repType (lowerEnum names)
  repType BooleanTy = repType lowerBool
  repType TyVar{} = error "repType: TyVar"
  repType HasTy{} = error "repType: HasTy"
  repType HasKey{} = error "repType: HasKey"
  repType ElementsOf{} = error "repType: ElementsOf"
  
  sumLike :: Type -> Maybe [Glean.RTS.Types.FieldDef]
  sumLike (SumTy fs) = Just fs
  sumLike (MaybeTy ty) = Just (maybeFields ty)
  sumLike (EnumeratedTy names) = Just (enumFields names)
  sumLike BooleanTy = Just boolFields
  sumLike _ = Nothing
  
  -- | Compare types for (structural) equality
  eqType :: AngleVersion -> Type -> Type -> Bool
  eqType version a b = case (a,b) of
    (ByteTy, ByteTy) -> True
    (NatTy, NatTy) -> True
    (StringTy, StringTy) -> True
    (ArrayTy a, ArrayTy b) -> eqType version a b
    (RecordTy as, RecordTy bs) ->
      let isTuple = all (Text.isInfixOf "tuplefield"  . fieldDefName)
          -- previous to version 7 records were always compared structurally
          compareStructurally =
            version < AngleVersion 7 || isTuple as || isTuple bs
          -- structural equality for tuples by ignoring field names.
          eqField fa fb = fa == fb
      in
      length as == length bs &&
      and [ eqType version a b && (compareStructurally || eqField fa fb)
          | (FieldDef fa a, FieldDef fb b) <- zip as bs ]
    (SumTy as, SumTy bs) ->
      length as == length bs &&
      and [ eqType version a b | (FieldDef _ a, FieldDef _ b) <- zip as bs ]
    (PredicateTy _ (PidRef p _), PredicateTy _ (PidRef q _)) -> p == q
    (NamedTy _ (ExpandedType n t), NamedTy _ (ExpandedType m u)) ->
      n == m || eqType version t u
    (NamedTy _ (ExpandedType _ t), u) -> eqType version t u
    (t, NamedTy _ (ExpandedType _ u)) -> eqType version t u
    (MaybeTy t, MaybeTy u) -> eqType version t u
    (MaybeTy t, u) ->  eqType version (lowerMaybe t) u
    (t, MaybeTy u) -> eqType version t (lowerMaybe u)
    (EnumeratedTy xs, EnumeratedTy ys) -> xs == ys
    (EnumeratedTy xs, t) -> eqType version (lowerEnum xs) t
    (t, EnumeratedTy xs) -> eqType version t (lowerEnum xs)
    (BooleanTy, BooleanTy) -> True
    (BooleanTy, t) -> eqType version lowerBool t
    (t, BooleanTy) -> eqType version t lowerBool
    _ -> False
  
  -- | dereference NamedTy on the outside of a Type
  derefType :: Type -> Type
  derefType (NamedTy _ (ExpandedType _ ty)) = derefType ty
  derefType ty = ty
  
  -- | Type describing the raw representation of a value. This makes
  -- fewer distinctions than Type, in particular: there are no field
  -- names or named types, and sugar like maybe, bool and enumerations
  -- are expanded into their low-level representations.
  data Rep id
    = ByteRep
    | NatRep
    | ArrayRep (Rep id)
    | TupleRep [Rep id]
    | SumRep [Rep id]
    | SetRep (Rep id)
    | StringRep
    | PredicateRep id
    deriving (Eq, Show, Functor, Foldable, Traversable)
  
  instance Pretty id => Pretty (Rep id) where
    pretty ByteRep = "byte#"
    pretty NatRep = "nat#"
    pretty (ArrayRep ty) = "[" <> pretty ty <> "]"
    pretty (TupleRep ty) = align $ encloseSep "(" ")" "," $ map pretty ty
    pretty (SumRep ty) = align $ encloseSep "(|" "|)" "," $ map pretty ty
    pretty (SetRep ty) = "set " <> pretty ty
    pretty StringRep = "string#"
    pretty (PredicateRep id) = pretty id
  