Refactoring

Summary:
Introduce an enum `RecordOrSum` and use it instead of `Bool` in a
couple of places.

Reviewed By: josefs

Differential Revision: D62503588

fbshipit-source-id: 7003c86d8e55927c1e085de1997b296bc1bdf7a1

glean/db/Glean/Database/Schema.hs

@@ -67,7 +67,7 @@ import Safe (maximumMay)
 import TextShow
 
 import ServiceData.GlobalStats
-import ServiceData.Types
+import ServiceData.Types as ODS
 import Util.Log.Text
 
 import Glean.RTS.Foreign.Inventory as Inventory
@@ -321,19 +321,19 @@ withDbSchemaCache maybeCache maybePids stored maybeIndex mk =
       let key = dbSchemaKey pidMap stored maybeIndex
       case HashMap.lookup key cache of
         Just schema -> do
-          addStatValueType "glean.db.schema.cache.hit" 1 Sum
+          addStatValueType "glean.db.schema.cache.hit" 1 ODS.Sum
           vlog 2 $ "DbSchema cache hit, stored SchemaId: " <>
             maybe "<unknown>" (unSchemaId . snd)
               (IntMap.lookupMax (hashedSchemaAllVersions
                 (procSchemaHashed stored)))
           return schema
         Nothing -> do
-          addStatValueType "glean.db.schema.cache.miss" 1 Sum
+          addStatValueType "glean.db.schema.cache.miss" 1 ODS.Sum
           schema <- mk
           modifyMVar_ cacheVar $ return . HashMap.insert key schema
           return schema
     _otherwise -> do
-      addStatValueType "glean.db.schema.cache.fail" 1 Sum
+      addStatValueType "glean.db.schema.cache.fail" 1 ODS.Sum
       mk
 
 mkDbSchema

glean/db/Glean/Query/Typecheck.hs

@@ -390,7 +390,7 @@ inferExpr ctx pat = case pat of
     x <- freshTyVarInt
     let
       must_be_rec
-        | length fields > 1 = Just True
+        | length fields > 1 = Just Record
         | otherwise = Nothing
       ty = HasTy (Map.fromList types) must_be_rec x
     promote (sourcePatSpan pat)
@@ -420,9 +420,9 @@ fieldSelect
   -> Type
   -> TcPat
   -> FieldName
-  -> Bool
+  -> RecordOrSum
   -> T (TcPat, Type)
-fieldSelect src ty pat fieldName sum = do
+fieldSelect src ty pat fieldName recordOrSum = do
   opts <- gets tcDisplayOpts
   let err x = do
         prettyErrorIn src $ nest 4 $ vcat
@@ -437,9 +437,9 @@ fieldSelect src ty pat fieldName sum = do
       let deref = TcDeref ty predicateValueType pat
       fieldSelect src predicateKeyType
         (Ref (MatchExt (Typed predicateKeyType deref)))
-        fieldName sum
+        fieldName recordOrSum
     RecordTy fields
-      | not sum -> case lookupField fieldName fields of
+      | Record <- recordOrSum -> case lookupField fieldName fields of
           (fieldTy,_):_ -> do
             let sel = TcFieldSelect (Typed ty pat) fieldName
             return (Ref (MatchExt (Typed fieldTy sel)), fieldTy)
@@ -450,7 +450,7 @@ fieldSelect src ty pat fieldName sum = do
         "expression is a record, use '." <> pretty fieldName <>
           "' not '." <> pretty fieldName <> "?'"
     SumTy fields
-      | sum -> case lookupField fieldName fields of
+      | Sum <- recordOrSum -> case lookupField fieldName fields of
           (fieldTy,_):_ -> do
             let sel = TcAltSelect (Typed ty pat) fieldName
             return (Ref (MatchExt (Typed fieldTy sel)), fieldTy)
@@ -461,18 +461,21 @@ fieldSelect src ty pat fieldName sum = do
         "expression is a union type, use '." <> pretty fieldName <>
           "?' not '." <> pretty fieldName <> "'"
     MaybeTy elemTy ->
-      fieldSelect src (lowerMaybe elemTy) pat fieldName sum
+      fieldSelect src (lowerMaybe elemTy) pat fieldName recordOrSum
     TyVar{} -> do
       x <- freshTyVarInt
       fieldTy <- freshTyVar
-      let recTy = HasTy (Map.singleton fieldName fieldTy) (Just (not sum)) x
+      let recTy = HasTy (Map.singleton fieldName fieldTy) (Just recordOrSum) x
       -- allow the lhs to be a predicate:
       fn <- demoteTo (sourcePatSpan src) ty' recTy
-      let sel | sum = TcAltSelect (Typed recTy (fn pat)) fieldName
-              | otherwise = TcFieldSelect (Typed recTy (fn pat)) fieldName
+      let sel = case recordOrSum of
+            Sum -> TcAltSelect (Typed recTy (fn pat)) fieldName
+            Record -> TcFieldSelect (Typed recTy (fn pat)) fieldName
       return (Ref (MatchExt (Typed fieldTy sel)), fieldTy)
     _other ->
-      err $ "expression is not a " <> if sum then "union type" else "record"
+      err $ "expression is not a " <> case recordOrSum of
+        Sum -> "union type"
+        Record -> "record"
 
 convertType
   :: IsSrcSpan s => s -> ToRtsType -> Schema.Type -> T Type

glean/db/Glean/Query/Typecheck/Unify.hs

@@ -81,7 +81,7 @@ unify a@(HasTy fa ra x) b@(HasTy fb rb y) = do
   extend x all
   extend y all
 
-unify a@(HasTy _ (Just False) _) b@RecordTy{} =
+unify a@(HasTy _ (Just Sum) _) b@RecordTy{} =
   unifyError a b
 unify a@(HasTy m _ x) b@(RecordTy fs) = do
   forM_ fs $ \(FieldDef f ty) ->
@@ -93,7 +93,7 @@ unify a@(HasTy m _ x) b@(RecordTy fs) = do
       unifyError a b
   extend x (RecordTy fs)
 
-unify a@(HasTy _ (Just True) _) b@SumTy{} =
+unify a@(HasTy _ (Just Record) _) b@SumTy{} =
   unifyError a b
 unify a@(HasTy m _ x) b@(SumTy fs) = do
   forM_ fs $ \(FieldDef f ty) ->

glean/hs/Glean/Angle/Parser.y

@@ -155,8 +155,8 @@ kv
 
 select :: { SourcePat }
 select
-  : select SELECT { FieldSelect (s $1 $2) $1 (lval $2) False }
-  | select SELECTALT { FieldSelect (s $1 $2) $1 (lval $2) True }
+  : select SELECT { FieldSelect (s $1 $2) $1 (lval $2) Record }
+  | select SELECTALT { FieldSelect (s $1 $2) $1 (lval $2) Sum }
   | apat  { $1 }
 
 apat :: { SourcePat }

glean/hs/Glean/Angle/Types.hs

@@ -39,6 +39,7 @@ module Glean.Angle.Types
 
   -- * Types
   , Type_(..)
+  , RecordOrSum(..)
 
   -- * Queries
   , SourceQuery_(..)
@@ -218,7 +219,7 @@ data SourcePat_ s p t
       , then_ :: SourcePat_ s p t
       , else_ :: SourcePat_ s p t
       }
-  | FieldSelect s (SourcePat_ s p t) FieldName Bool
+  | FieldSelect s (SourcePat_ s p t) FieldName RecordOrSum
   | Enum s Text
 
   -- The following forms are introduced by the resolver, and replace
@@ -398,19 +399,24 @@ data Type_ pref tref
 
   -- These are used during typechecking only
   | TyVar {-# UNPACK #-}!Int
-  | HasTy (Map Name (Type_ pref tref)) !(Maybe Bool) {-# UNPACK #-}!Int
+  | HasTy (Map Name (Type_ pref tref)) !(Maybe RecordOrSum) {-# UNPACK #-}!Int
     -- HasTy { field:type .. } R X
     --   Constrains X to be a record or sum type containing at least
     --   the given fields/types. X can only be instantiated
     --   with a type containing a superset of those fields: either
     --   a bigger HasTy or a RecordTy/SumTy.
     --   R is
-    --     Just True -> type must be a record
-    --     Just False -> type must be a sum type
-    --     Nothing -> type can beeither a RecordTy or a SumTy
+    --     Just Record -> type must be a record
+    --     Just Sum -> type must be a sum type
+    --     Nothing -> type can be either a RecordTy or a SumTy
     --   can be
   deriving (Eq, Show, Functor, Foldable, Generic)
 
+data RecordOrSum = Record | Sum
+  deriving (Eq, Show, Generic)
+
+instance Binary RecordOrSum
+
 instance (Binary pref, Binary tref) => Binary (Type_ pref tref)
 
 instance Bifunctor Type_ where
@@ -713,7 +719,7 @@ instance (Display pref, Display tref) => Display (Type_ pref tref) where
   display _ BooleanTy = "bool"
   display _ (TyVar n) = "T" <> pretty n
   display opts (HasTy m rec x)
-    | Just False <- rec =
+    | Just Sum <- rec =
     sep
       [ nest 2 $ vsep $ "{" :  intersperse "|" (map doField (Map.toList m))
       , "|", "T" <> pretty x, "}" ]
@@ -881,7 +887,10 @@ instance (Display p, Display t) => Display (SourcePat_ s p t) where
   display opts (Prim _ p pats) =
     display opts p <+> hsep (punctuate " " (map (displayAtom opts) pats))
   display opts (FieldSelect _ pat field q) =
-    displayAtom opts pat <> "." <> pretty field <> if q then "?" else mempty
+    displayAtom opts pat <> "." <> pretty field <>
+      case q of
+        Sum -> "?"
+        Record -> mempty
   display _ (Enum _ f) = pretty f
 
   displayAtom opts pat = case pat of