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 AllowAmbiguousTypes #-}
  {-# LANGUAGE ConstraintKinds #-}
  {-# LANGUAGE PolyKinds #-}
  {-# LANGUAGE TypeOperators #-}
  {-# OPTIONS_GHC -Wno-star-is-type #-}
  module Thrift.Compiler.Types
    ( Status(..), IfResolved, Parsed
    , Program(..), Header(..), ParsedStatement(..), IncludeType(..), Decl(..), SpliceFile
    , Loc(..), noLoc, nlc, Comment(..), Located(..)
    , Separator(..), getSepLoc
    , Annotations(..), Annotation(..), AnnValue(..), getAnns, annLoc
    , StructuredAnnotation(..), StructuredAnnotationElems(..)
    , ThriftPriority(..)
    , Env(..), emptyEnv, Context(..), emptyContext
    , TypeMap, SchemaMap, UnionMap, EnumMap, ConstMap, ServiceMap, ImportMap
    , EnumValues, EnumInt
    , Typedef(..), TypedefTag(..), TypedefLoc(..)
    , Const(..), ConstLoc(..)
    , UntypedConst(..), ConstVal(..), ListElem(..), MapPair(..), QuoteType(..)
    , StructPair (..)
    , TypedConst(..)
    , List(..), Set(..), HashSet(..), Map(..), HashMap(..), EnumVal(..), New(..)
    , StructVal(..), ExceptionVal(..), UnionVal(..), MembershipProof(..)
    , Struct(..), StructType(..), StructLoc(..), ErrorClassification(..)
    , ErrorClassificationType(..)
    , Field(..), FieldLoc(..), FieldType(..), FieldTag(..), FieldId
    , Requiredness(..), Laziness(..)
    , Union(..), UnionAlt(..), PossiblyEmpty(..), EmptyName
    , Enum(..), EnumFlavour(..), EnumValue(..), EnumValLoc(..)
    , EnumValueType, enumValueType
    , Service(..), Super(..), Function(..), FunLoc(..), getServiceFunctions
    , ServiceStmt(..), Performs(..)
    , funThrows, ThrowsLoc(..), Throws(..), FunctionType(..)
    , Interaction(..)
    , RpcIdempotency(..), RpcIdempotencyType(..)
    , Stream(..), ResponseAndStreamReturn(..), rsTypeLoc, rsLoc
    , Type, AnnotatedType(..), TType(..), SomeAnnTy(..)
    , TypeLoc(..), GetArity, getTypeLoc
    , SCHEMA(..), Schema, USchema
    , SpecialType
    , Name(..), ThriftName, Name_(..), localName, mapName, mkName
    , filterHiddenFields
    ) where
  
  import Prelude hiding (Enum)
  import Data.ByteString (ByteString)
  import Data.Int
  import Data.Proxy
  import Data.Some
  import Data.Text (Text)
  import GHC.TypeLits
  import qualified Data.Map as Map
  import qualified Data.Set as Set
  
  import Language.Haskell.Exts.SrcLoc (SrcSpanInfo)
  import Language.Haskell.Exts.Syntax (Module)
  
  import Thrift.Compiler.Options
  
  data Status = Resolved | Unresolved
  
  type Parsed t = t 'Unresolved () Loc
  
  type family IfResolved (s :: Status) (t :: *) :: * where
    IfResolved 'Unresolved t = ()
    IfResolved 'Resolved   t = t
  
  data ThriftPriority
    = HighImportant
    | High
    | Important
    | NormalPriority
    | BestEffort
    | NPriorities
    deriving (Show, Eq)
  
  -- Thrift Program --------------------------------------------------------------
  
  data Program (l :: * {- Language -}) a = Program
    { progName      :: Text           -- ^ Thrift name
    , progHSName    :: Text           -- ^ Haskell module prefix (with namespace)
    , progPath      :: FilePath
    , progOutPath   :: FilePath
    , progInstances :: SpliceFile
    , progIncludes  :: [Program l a]
    , progHeaders   :: [Header 'Resolved l a]
    , progDecls     :: [Decl 'Resolved l a]
    , progComments  :: [Comment a]
    , progEnv       :: Env l
    }
  
  data ParsedStatement
    = StatementHeader (Parsed Header)
    | StatementDecl (Parsed Decl)
  
  data Header s l a
    = HInclude
      { incPath       :: FilePath
      , incType       :: IncludeType
      , incKeywordLoc :: Located a
      , incPathLoc    :: Located a
      , incQuoteType  :: QuoteType
      }
    | HNamespace
      { nmLang       :: Text
      , nmName       :: Text
      , nmKeywordLoc :: Located a
      , nmLangLoc    :: Located a
      , nmNameLoc    :: Located a
      , nmQuoteType  :: Maybe QuoteType
      }
    | HPackage
      { pkgUri         :: Text
      , pkgKeywordLoc  :: Located a
      , pkgUriLoc      :: Located a
      , pkgQuoteType   :: QuoteType
      , pkgSAnns       :: [StructuredAnnotation s l a]
      }
  
  data IncludeType = Include | HsInclude | CppInclude
  
  data Decl s l a
    = D_Struct (Struct s l a)
    | D_Union (Union s l a)
    | D_Enum (Enum s l a)
    | D_Typedef (Typedef s l a)
    | D_Const (Const s l a)
    | D_Service (Service s l a)
    | D_Interaction (Interaction s l a)
  
  type SpliceFile = Maybe (Module SrcSpanInfo)
  
  data Annotations a = Annotations
    { annList :: [Annotation a]
    , annOpenParen  :: Located a
    , annCloseParen :: Located a
    }
  
  data Annotation a
    = SimpleAnn
      { saTag :: Text
      , saLoc :: Located a
      , saSep :: Separator a
      }
    | ValueAnn
      { vaTag :: Text
      , vaVal :: AnnValue
      , vaTagLoc :: Located a
      , vaEqual  :: Located a
      , vaValLoc :: Located a
      , vaSep    :: Separator a
      }
  
  data AnnValue = IntAnn Int Text | TextAnn Text QuoteType
  
  getAnns :: Maybe (Annotations a) -> [Annotation a]
  getAnns = maybe [] annList
  
  annLoc :: Annotation a -> a
  annLoc SimpleAnn{..} = lLocation saLoc
  annLoc ValueAnn{..} = lLocation vaTagLoc
  
  data StructuredAnnotation (s :: Status) (l :: *) a = forall t. StructuredAnn
    { saAt :: Located a
    , saType :: Text
    , saTypeLoc :: TypeLoc 0 a
    , saMaybeElems :: Maybe (StructuredAnnotationElems a)
    , saResolvedType :: IfResolved s (Type l t)
    , saResolvedVal :: IfResolved s (Some (StructVal l))
    }
  
  data StructuredAnnotationElems a = StructuredAnnElems
    { saOpenBrace  :: Located a
    , saElems      :: [ListElem StructPair a]
    , saCloseBrace :: Located a
    }
  
  data Loc = Loc
    { locFile :: FilePath
    , locStartLine :: Int
    , locStartCol  :: Int
    , locEndLine   :: Int
    , locEndCol    :: Int
    } deriving (Show, Eq)
  
  instance Ord Loc where
    l1 <= l2
      | locFile l1 == locFile l2 =
          if locStartLine l1 == locStartLine l2
          then locStartCol l1 <= locStartCol l2
          else locStartLine l1 <= locStartLine l2
      | otherwise = locFile l1 <= locFile l2
  
  noLoc :: Loc
  noLoc = Loc "" 0 0 0 0
  
  nlc :: Located Loc
  nlc = Located [] noLoc
  
  data Comment a = Comment a Text
    deriving (Show, Eq)
  
  data Located a = Located
    { lComments :: [Comment a]
    , lLocation :: a
    } deriving (Show, Eq)
  
  data Separator a
    = Semicolon (Located a)
    | Comma (Located a)
    | NoSep
  
  getSepLoc :: Separator a -> Maybe (Located a)
  getSepLoc (Semicolon loc) = Just loc
  getSepLoc (Comma loc) = Just loc
  getSepLoc NoSep = Nothing
  
  -- Environment -----------------------------------------------------------------
  
  -- | The type checking environment keeps track of
  data Env (l :: * {- Language -}) = Env
    { typeMap    :: TypeMap l   -- ^ Local Named Types
    , schemaMap  :: SchemaMap l -- ^ Local Schemas
    , unionMap   :: UnionMap l  -- ^ Local Union Schemas
    , enumMap    :: EnumMap     -- ^ Local Enums
    , enumInt    :: EnumInt
      -- ^ Local Enums as Int for default values, weird mode
    , constMap   :: ConstMap l  -- ^ Local Constants
    , serviceMap :: ServiceMap  -- ^ Local Services
    , importMap  :: ImportMap l -- ^ all the modules that are in scope
    , options    :: Options l   -- ^ Program options
    , envName    :: Text        -- ^ The 'thriftName' of this 'Env'
    }
  
  -- | Help build a specialized 'Env' for 'runTypechecker' while
  -- 'typecheckModule' is constructing the final 'Env' and 'Program'
  emptyEnv :: (Text, Options l) -> Env l
  emptyEnv (thriftName, opts) = Env
    { typeMap   = emptyContext
    , schemaMap = Map.empty
    , unionMap  = Map.empty
    , enumMap   = Map.empty
    , enumInt   = Map.empty
    , constMap  = emptyContext
    , serviceMap = Map.empty
    , importMap = Map.empty
    , options   = opts
    , envName   = thriftName
    }
  
  data Context a = Context
    { cMap   :: Map.Map Text a -- ^ Map to lookup value of a symbol
    , cScope :: Set.Set Text   -- ^ Additional set of symbols that are in scope
                               -- ie hsNames for types and constants
    }
  
  emptyContext :: Context a
  emptyContext = Context
    { cMap   = Map.empty
    , cScope = Set.empty
    }
  
  type TypeMap l   = Context (Some (Type l))
  type SchemaMap l = Map.Map Text (Some (Schema l))
  type UnionMap l  = Map.Map Text (Some (USchema l))
  type EnumMap     = Map.Map Text EnumValues
  -- For Constants, we store the renamed version in addition to the type
  type ConstMap l  = Context (Some (Type l), Name, Loc)
  -- For Service, we store the Set Text of renamed functions for scoping
  type ServiceMap  = Map.Map Text (Name, Set.Set Text, Loc)
  type ImportMap l = Map.Map Text (Env l)
  
  -- We need to be able to look up the constants keyed by their numeric value
  -- or themselves
  type EnumValues = (Map.Map EnumValueType (Name, Loc), Map.Map Text (Name, Loc))
  
  -- | There are weird thrift file using enum constants as I32 and I64 defaults,
  -- (as unqualified names).  If there is a name collision with different value
  -- this holds Nothing to detect the ambiguity. Active when weird mode is on.
  type EnumInt = Map.Map Text (Maybe EnumValueType)
  
  -- Thrift Typedef --------------------------------------------------------------
  
  data Typedef (s :: Status) (l :: * {- Language -}) a = forall v t. Typedef
    { tdName         :: Text
    , tdTag          :: TypedefTag s
    , tdResolvedName :: IfResolved s Text
    , tdType         :: AnnotatedType a v
    , tdResolvedType :: IfResolved s (Type l t)
    , tdLoc          :: TypedefLoc a
    , tdAnns         :: Maybe (Annotations a)
    , tdSAnns        :: [StructuredAnnotation s l a]
    }
  
  data TypedefTag (s :: Status) where
    IsTypedef :: TypedefTag s
    IsNewtype :: TypedefTag 'Resolved
  
  data TypedefLoc a = TypedefLoc
    { tdlKeyword :: Located a
    , tdlName    :: Located a
    }
  
  -- Thrift Constant--------------------------------------------------------------
  
  data Const (s :: Status) (l :: * {- Language -}) a = forall v t. Const
    { constName         :: Text
    , constResolvedName :: IfResolved s Text
    , constType         :: AnnotatedType a v
    , constVal          :: UntypedConst a
    , constResolvedType :: IfResolved s (Type l t)
    , constResolvedVal  :: IfResolved s (TypedConst l t)
    , constLoc          :: ConstLoc a
    , constSAnns        :: [StructuredAnnotation s l a]
    }
  
  data ConstLoc a = ConstLoc
    { clKeyword   :: Located a
    , clName      :: Located a
    , clEqual     :: Located a
    , clSeparator :: Separator a
    }
  
  data UntypedConst a = UntypedConst
    { ucLoc   :: Located a
    , ucConst :: ConstVal a
    }
  
  data ConstVal a
    = IntConst Int Text
    -- ^ Includes are numeric types, enums, and booleans
    | DoubleConst Double Text
    -- ^ Doubles and Floats
    | StringConst Text QuoteType
    | IdConst Text
    | ListConst
      { lvElems      :: [ListElem UntypedConst a]
      , lvCloseBrace :: Located a
      }
    -- ^ Lists and Sets
    | MapConst
      { mvElems      :: [ListElem MapPair a]
      , mvCloseBrace :: Located a
      }
    -- ^ Maps and Structs
    | StructConst
      { svType       :: Text
      , svOpenBrace  :: Located a
      , svElems      :: [ListElem StructPair a]
      , svCloseBrace :: Located a
      }
    | BoolConst Bool
  
  data ListElem t a = ListElem
    { leElem :: t a
    , leSeparator :: Separator a
    }
  
  data MapPair a = MapPair
    { mpKey   :: UntypedConst a
    , mpColon :: Located a
    , mpVal   :: UntypedConst a
    }
  
  data StructPair a = StructPair
    { spKey :: Text
    , spKeyLoc :: Located a
    , spEquals:: Located a
    , spVal:: UntypedConst a
    }
  
  data QuoteType = SingleQuote | DoubleQuote
    deriving (Show, Eq)
  
  data TypedConst l t
    = Literal t
    | Identifier Name (Type l t) Loc -- ^ Loc for definition of Name
    | WeirdEnumToInt (Type l t) Name (Type l EnumVal) Loc
  
  newtype List l t      = List [TypedConst l t]
  newtype Set l t       = Set [TypedConst l t]
  newtype HashSet l t   = HashSet [TypedConst l t]
  newtype Map l k v     = Map [(TypedConst l k, TypedConst l v)]
  newtype HashMap l k v = HashMap [(TypedConst l k, TypedConst l v)]
  
  -- | Include Loc of definition (from EnumValLoc)
  data EnumVal = EnumVal Name Loc
  
  newtype New t = New t
  
  -- The fields of a struct are encoded in the type parameter of the StructVal
  -- s has kind [(Symbol, *)]. The Symbol is a type-level string, which is the
  -- name of the field and the * is the actual type of the field. A list of these
  -- pairs makes a StructVal
  data StructVal (l :: * {- Language -}) (s :: [(Symbol, *)]) where
    Empty :: StructVal l '[]
  
    ConsVal
      :: forall (name :: Symbol) l t s. KnownSymbol name
      => Proxy name
      -> Type l t
      -> TypedConst l t
      -> StructVal l s
      -> StructVal l ('(name, t) ': s)
    ConsDefault
      :: forall (name :: Symbol) l t s. KnownSymbol name
      => Proxy name
      -> Type l t
      -> StructVal l s
      -> StructVal l ('(name, t) ': s)
    ConsJust
      :: forall (name :: Symbol) l t s. KnownSymbol name
      => Proxy name
      -> Type l t
      -> TypedConst l t
      -> StructVal l s
      -> StructVal l ('(name, Maybe t) ': s)
    ConsNothing
      :: forall (name :: Symbol) l t s. KnownSymbol name
      => Proxy name
      -> StructVal l s
      -> StructVal l ('(name, Maybe t) ': s)
  
  newtype ExceptionVal l s = EV (StructVal l s)
  
  -- Unions have exactly one value out of a list of possible values. However, they
  -- also need to include a MembershipProof which proves that the present field is
  -- a member of the union's schema
  data UnionVal (l :: * {- Language -}) (s :: [(Symbol, *)]) where
    UnionVal
      :: forall (name :: Symbol) l s t. KnownSymbol name
      => Proxy name
      -> Type l t
      -> TypedConst l t
      -> MembershipProof '(name, t) s
      -> UnionVal l s
  
  -- Proof that a field is a memeber of a schema
  data MembershipProof x xs where
    -- The field is the first field in the type list
    PHere  :: MembershipProof x (x ': xs)
    -- The field is buried somewhere deeper in the type list
    PThere :: MembershipProof x xs -> MembershipProof x (y ': xs)
  
  -- Thrift Structs and Exceptions -----------------------------------------------
  
  data Struct s l a = Struct
    { structName           :: Text
    , structResolvedName   :: IfResolved s Text
    , structType           :: StructType
    , structMembers        :: [Field 'StructField s l a]
    , structLoc            :: StructLoc a
    , structAnns           :: Maybe (Annotations a)
    , structSAnns          :: [StructuredAnnotation s l a]
    , errorClassifications :: [ErrorClassification a]
    }
  
  data StructType = StructTy | ExceptionTy
  
  data StructLoc a = StructLoc
    { slKeyword    :: Located a
    , slName       :: Located a
    , slOpenBrace  :: Located a
    , slCloseBrace :: Located a
    }
  
  data ErrorClassification a = ErrorClassification
    { ecType       :: ErrorClassificationType
    , ecKeywordLoc :: Located a
    }
  
  data ErrorClassificationType =
    EcSafe | EcTransient | EcStateful | EcPermanent | EcServer | EcClient
  
  -- Thrift Fields ---------------------------------------------------------------
  
  data FieldType = StructField | Argument | ThrowsField
  
  data FieldTag u s l t where
    STRUCT_FIELD :: FieldTag 'StructField s l t
    ARGUMENT     :: FieldTag 'Argument s l t
    THROWS_UNRESOLVED :: FieldTag 'ThrowsField 'Unresolved l t
    THROWS_RESOLVED   :: FieldTag 'ThrowsField 'Resolved l (Some (ExceptionVal l))
  
  data Field u s l a = forall v t. Field
    { fieldId           :: FieldId
    , fieldName         :: Text
    , fieldResolvedName :: IfResolved s Text
    , fieldType         :: AnnotatedType a v
    , fieldResolvedType :: IfResolved s (Type l t)
    , fieldVal          :: Maybe (UntypedConst a)
    , fieldResolvedVal  :: IfResolved s (Maybe (TypedConst l t))
    , fieldRequiredness :: Requiredness u a
    , fieldLaziness     :: Laziness
    , fieldTag          :: FieldTag u s l t
    , fieldLoc          :: FieldLoc a
    , fieldAnns         :: Maybe (Annotations a)
    , fieldSAnns        :: [StructuredAnnotation s l a]
    }
  
  type FieldId = Int32
  
  data Requiredness u a where
    Default :: Requiredness u a
  
    -- Optional and Required are only for Struct Fields (not arguments)
    Optional :: Located a -> Requiredness 'StructField a
    Required :: Located a -> Requiredness 'StructField a
  
  data Laziness = Lazy | Strict
  
  data FieldLoc a = FieldLoc
    { flId        :: Located a
    , flIdRep     :: Text
    , flColon     :: Located a
    , flName      :: Located a
    , flEqual     :: Maybe (Located a)
    , flSeparator :: Separator a
    }
  
  -- Thrift Unions ---------------------------------------------------------------
  
  data Union s l a = forall u. Union
    { unionName         :: Text
    , unionResolvedName :: IfResolved s Text
    , unionAlts         :: [UnionAlt s l a]
    , unionEmptyName    :: EmptyName s u
    , unionHasEmpty     :: PossiblyEmpty u
    , unionLoc          :: StructLoc a
    , unionAnns         :: Maybe (Annotations a)
    , unionSAnns        :: [StructuredAnnotation s l a]
    }
  
  data UnionAlt (s :: Status) (l :: * {- Language -}) a = forall v t. UnionAlt
    { altId           :: FieldId
    , altName         :: Text
    , altResolvedName :: IfResolved s Text
    , altType         :: AnnotatedType a v
    , altResolvedType :: IfResolved s (Type l t)
    , altLoc          :: FieldLoc a
    , altAnns         :: Maybe (Annotations a)
    , altSAnns        :: [StructuredAnnotation s l a]
    }
  
  data PossiblyEmpty (u :: Bool) where
    HasEmpty :: PossiblyEmpty 'True
    NonEmpty :: PossiblyEmpty 'False
  
  type family EmptyName s u where
    EmptyName 'Unresolved u = ()
    EmptyName 'Resolved 'True  = Text
    EmptyName 'Resolved 'False = ()
  
  -- Thrift Enums ----------------------------------------------------------------
  
  data Enum (s :: Status) (l :: * {- Language -}) a = Enum
    { enumName         :: Text
    , enumResolvedName :: IfResolved s Text
    , enumFlavour      :: IfResolved s EnumFlavour
    , enumConstants    :: [EnumValue s l a]
    , enumLoc          :: StructLoc a
    , enumAnns         :: Maybe (Annotations a)
    , enumSAnns        :: [StructuredAnnotation s l a]
    }
  
  data EnumFlavour
    = SumTypeEnum
      { enumNoUnknown :: Bool
      }
    | PseudoEnum
      { peThriftEnum :: Bool
      }
  
  data EnumValue (s :: Status) (l :: * {- Language -}) a = EnumValue
    { evName         :: Text
    , evResolvedName :: IfResolved s Text
    , evValue        :: EnumValueType
    , evLoc          :: EnumValLoc a
    , evAnns         :: Maybe (Annotations a)
    , evSAnns        :: [StructuredAnnotation s l a]
    }
  
  type EnumValueType = Int32
  
  enumValueType :: TType s l a EnumValueType
  enumValueType = I32
  
  data EnumValLoc a = EnumValLoc
    { evlName      :: Located a
    , evlEqual     :: Located a
    , evlValue     :: Located a
    , evlRep       :: Text
    , evlSeparator :: Separator a
    }
  
  -- Thrift Service --------------------------------------------------------------
  
  data Service (s :: Status) (l :: * {- Language -}) a = Service
    { serviceName         :: Text
    , serviceResolvedName :: IfResolved s Text
    , serviceSuper        :: Maybe (Super s a)
    -- , serviceFunctions    :: [Function s l a]
    , serviceStmts        :: [ServiceStmt s l a]
    , serviceLoc          :: StructLoc a
    , serviceAnns         :: Maybe (Annotations a)
    , serviceSAnns        :: [StructuredAnnotation s l a]
    }
  
  getServiceFunctions :: Service s l a -> [Function s l a]
  getServiceFunctions Service {..} = concatMap getFn serviceStmts
    where
      getFn (FunctionStmt f ) = [f]
      getFn _ = []
  
  data Super s a = Super
    { supName         :: Text
    , supResolvedName :: IfResolved s (Name, Loc)
    , supExtends      :: Located a -- ^ location of "extends" keyword
    , supLoc          :: Located a -- ^ location of "supName" after "extends"
    }
  
  data ServiceStmt s l a
    = FunctionStmt (Function s l a)
    | PerformsStmt (Performs s l a)
  
  newtype Performs (s :: Status) (l :: * {- Language -}) a = Performs
    { performsName :: Text
    }
  
  data Function (s :: Status) (l :: * {- Language -}) a = Function
    { funName         :: Text
    , funResolvedName :: IfResolved s Text
    , funType         :: FunctionType s l a
    , funResolvedType :: IfResolved s (Maybe (Some (Type l)))
    , funArgs         :: [Field 'Argument s l a]
    , funExceptions   :: [Field 'ThrowsField s l a]
    , funIsOneWay     :: Bool
    , funPriority     :: ThriftPriority
    , funLoc          :: FunLoc a
    , funAnns         :: Maybe (Annotations a)
    , funSAnns        :: [StructuredAnnotation s l a]
    , funIdempotency  :: Maybe RpcIdempotency
    }
  
  data FunctionType s l a
    = FunType (Some (AnnotatedType a))
    | FunTypeVoid (Located a)
    | FunTypeResponseAndStreamReturn (ResponseAndStreamReturn s l a)
  
  data ResponseAndStreamReturn s l a = forall v. ResponseAndStreamReturn
    { rsReturn :: Maybe (AnnotatedType a v)
    , rsComma :: Maybe (Located a)
    , rsStream :: Stream s l a
    }
  
  rsTypeLoc :: ResponseAndStreamReturn s l a -> SomeTypeLoc a
  rsTypeLoc ResponseAndStreamReturn{rsStream = Stream{..}, ..} = case rsReturn of
    Just AnnotatedType{..} -> ThisTypeLoc atLoc
    Nothing -> ThisTypeLoc streamLoc
  
  rsLoc :: ResponseAndStreamReturn s l a -> a
  rsLoc = loc . rsTypeLoc
    where loc (ThisTypeLoc l) = getTypeLoc l
  
  data Stream s l a = forall v. Stream
    { streamType :: AnnotatedType a v
    , streamThrows :: Maybe (Throws s l a)
    , streamLoc :: TypeLoc 1 a
    }
  
  data FunLoc a = FunLoc
    { fnlOneway      :: Maybe (Located a)
    , fnlIdempotency :: Maybe (Located a)
    , fnlName        :: Located a
    , fnlOpenParen   :: Located a
    , fnlCloseParen  :: Located a
    , fnlThrows      :: Maybe (ThrowsLoc a)
    , fnlSeparator   :: Separator a
    }
  
  data ThrowsLoc a = ThrowsLoc
    { tlThrows     :: Located a
    , tlOpenParen  :: Located a
    , tlCloseParen :: Located a
    }
  
  data Throws s l a = Throws
    { throwsLoc :: ThrowsLoc a
    , throwsFields :: [Field 'ThrowsField s l a]
    }
  
  funThrows
    :: Function s l a
    -> Maybe (Throws s l a)
  funThrows Function{funLoc=FunLoc{..}, ..} = fmap f fnlThrows
    where f throws = Throws throws funExceptions
  
  newtype RpcIdempotency = RpcIdempotency { riType :: RpcIdempotencyType }
  
  data RpcIdempotencyType = RiReadonly | RiIdempotent
  
  -- Thrift Interaction ----------------------------------------------------------
  
  data Interaction (s :: Status) (l :: * {- Language -}) a = Interaction
    { interactionName         :: Text
    , interactionResolvedName :: IfResolved s Text
    , interactionSuper        :: Maybe (Super s a)
    , interactionFunctions    :: [Function s l a]
    , interactionLoc          :: StructLoc a
    , interactionAnns         :: Maybe (Annotations a)
    , interactionSAnns        :: [StructuredAnnotation s l a]
    }
  
  
  -- Thrift Value Types ----------------------------------------------------------
  
  -- When a thrift file is parsed, all of the types are marked as 'Unresolved
  -- meaning that we don't know have any information about the named types.
  -- During type checking, these types become 'Resolved, a process by which all
  -- of the named types become either structs, enums, or typedefs
  type Type l = TType 'Resolved l Loc
  
  -- Annotations are resolved during typechecking, so we don't need them once
  -- types are resolved
  type family TypeOf (s :: Status) (l :: * {- Language -}) a :: * -> * where
    TypeOf 'Resolved l a   = Type l
    TypeOf 'Unresolved l a = AnnotatedType a
  
  data AnnotatedType a t = AnnotatedType
    { atType        :: TType 'Unresolved () a t
    , atAnnotations :: Maybe (Annotations a)
    , atLoc         :: TypeLoc (GetArity t) a
    }
  
  type family GetArity t :: Nat where
    GetArity (List l a) = 1
    GetArity (Set l a) = 1
    GetArity (HashSet l a) = 1
    GetArity (Map l a b) = 2
    GetArity (HashMap l a b) = 2
    GetArity a = 0
  
  data TypeLoc (n :: Nat) a where
    Arity0Loc :: { a0Ty :: Located a } -> TypeLoc 0 a
    Arity1Loc
      :: { a1Ty         :: Located a
         , a1OpenBrace  :: Located a
         , a1CloseBrace :: Located a
         }
      -> TypeLoc 1 a
    Arity2Loc
      :: { a2Ty         :: Located a
         , a2OpenBrace  :: Located a
         , a2Comma      :: Located a
         , a2CloseBrace :: Located a
         }
      -> TypeLoc 2 a
  
  getTypeLoc :: TypeLoc n a -> a
  getTypeLoc Arity0Loc{..} = lLocation a0Ty
  getTypeLoc Arity1Loc{..} = lLocation a1Ty
  getTypeLoc Arity2Loc{..} = lLocation a2Ty
  
  data SomeTypeLoc a =
    forall n. ThisTypeLoc (TypeLoc n a)
  
  data SomeAnnTy s l =
    forall t. ThisAnnTy (TType s l Loc t) (TypeLoc (GetArity t) Loc)
  
  data TType (s :: Status) (l :: * {- Language -}) a (t :: *) where
    -- Integral TTypes
    I8  :: TType s l a Int8
    I16 :: TType s l a Int16
    I32 :: TType s l a Int32
    I64 :: TType s l a Int64
  
    -- Floating Point TTypes
    TFloat  :: TType s l a Float
    TDouble :: TType s l a Double
  
    -- Other Base TTypes
    TBool   :: TType s l a Bool
    TText   :: TType s l a Text
    TBytes  :: TType s l a ByteString
  
    -- Collections
    TSet     :: TypeOf s l a t -> TType s l a (Set l t)
    THashSet :: TypeOf s l a t -> TType s l a (HashSet l t)
    TList    :: TypeOf s l a t -> TType s l a (List l t)
    TMap     :: TypeOf s l a k -> TypeOf s l a v -> TType s l a (Map l k v)
    THashMap :: TypeOf s l a k -> TypeOf s l a v -> TType s l a (HashMap l k v)
  
    -- TTypedefs
    TTypedef :: Name -> Type l t -> Loc -> TType 'Resolved l a t
    TNewtype :: Name -> Type l t -> Loc -> TType 'Resolved l a (New t)
  
    -- Structs
    TStruct    :: Name -> Loc -> TType 'Resolved l a (Some (StructVal l))
    TException :: Name -> Loc -> TType 'Resolved l a (Some (ExceptionVal l))
    TUnion     :: Name -> Loc -> TType 'Resolved l a (Some (UnionVal l))
  
    -- Enums
    TEnum   :: Name -> Loc -> Bool -> TType 'Resolved l a EnumVal
  
    -- Unresolved named types
    TNamed :: Text -> TType 'Unresolved l a ()
  
    -- Special types that we get by resolving annotations
    TSpecial :: SpecialType l t -> TType 'Resolved l a t
  
  data family SpecialType (l :: * {- Language -}) (t :: *)
  
  data SchemaType = StructSchema | UnionSchema
  
  type Schema l = SCHEMA l 'StructSchema
  type USchema l = SCHEMA l 'UnionSchema
  
  -- Schema for a struct, defines exactly what must be present
  data SCHEMA (l :: * {- Language -}) (t :: SchemaType) (s :: [(Symbol, *)]) where
    -- | Empty struct has type empty list
    SEmpty :: SCHEMA l u '[]
  
    SField
      :: forall (name :: Symbol) l t s. KnownSymbol name
      => Proxy name
      -> Text
      -> Type l t
      -> SCHEMA l 'StructSchema s
      -> SCHEMA l 'StructSchema ('(name, t) ': s)
  
    -- | For required fields, the value must be present
    SReqField
      :: forall (name :: Symbol) l u t s. KnownSymbol name
      => Proxy name
      -> Text
      -> Type l t
      -> SCHEMA l u s
      -> SCHEMA l u ('(name, t) ': s)
  
    -- | For optional fields, the value is a Maybe
    -- Only structs can have optional fields
    SOptField
       :: forall (name :: Symbol) l t s. KnownSymbol name
       => Proxy name
       -> Text
       -> Type l t
       -> SCHEMA l 'StructSchema s
       -> SCHEMA l 'StructSchema ('(name, Maybe t) ': s)
  
  -- | Renamed for target langauge
  data Name = Name
    { sourceName   :: ThriftName
    , resolvedName :: Name_ 'Resolved
    } deriving (Eq)
  
  -- | Name in the original thrift source file
  type ThriftName = Name_ 'Unresolved
  
  data Name_ (s :: Status)
    = UName Text
    | QName Text Text
    deriving (Eq,Show)
  
  localName :: Name_ s -> Text
  localName (UName n) = n
  localName (QName _ n) = n
  
  mapName :: (Text -> Text) -> Name_ s -> Name_ s
  mapName f (UName n) = UName $ f n
  mapName f (QName m n) = QName m $ f n
  
  mkName :: Text -> Text -> Name
  mkName tname rname = Name
    { sourceName = UName tname
    , resolvedName = UName rname
    }
  
  filterHiddenFields :: [Field u s l a] -> [Field u s l a]
  filterHiddenFields  = filter (not . isHiddenField)
    where
      isHiddenField Field{..} =
        any (\annot -> case annot of
          SimpleAnn{saTag = "hs.hidden"} -> True
          _ -> False
        ) $ getAnns fieldAnns
  