content: {-# LANGUAGE TupleSections #-}
  module Infernu.Builtins.Util
         where
  
  import           Control.Monad      (forM)
  
  import           Infernu.InferState (fresh, Infer)
  import           Infernu.Lib        (safeLookup)
  import           Infernu.Prelude
  import           Infernu.Expr       (EPropName(..))
  import           Infernu.Types
  
  func :: Type -> Type -> Type -> Type
  func this x y = Fix $ TFunc [this, x] y
  
  funcN :: [Fix FType] -> Fix FType -> Fix FType
  funcN xs tres = Fix $ TFunc xs tres
  
  string :: Type
  string = Fix $ TBody TString
  
  date :: Type
  date = Fix $ TBody TDate
  
  regex :: Type
  regex = Fix $ TBody TRegex
  
  nullT :: Type
  nullT = Fix $ TBody TNull
  
  number :: Type
  number = Fix $ TBody TNumber
  
  array :: Type -> Type
  array t = Fix $ TCons TArray [t]
  
  stringMap :: Type -> Type
  stringMap t = Fix $ TCons TStringMap [t]
  
  boolean :: Fix FType
  boolean = Fix $ TBody TBoolean
  
  undef :: Type
  undef = Fix $ TBody TUndefined
  
  ts :: [Int] -> t -> TScheme t
  ts vs t = TScheme (map Flex vs) $ qualEmpty t
  
  tsq :: [Int] -> TQual t -> TScheme t
  tsq vs = TScheme (map Flex vs)
  
  ty :: t -> TScheme t
  ty t = TScheme [] $ qualEmpty t
  
  tvar :: Int -> Type
  tvar = Fix . TBody . TVar . Flex
  
  withTypeClass :: String -> a -> a -> TQual a
  withTypeClass n t t' = TQual { qualPred = [TPredIsIn { predClass = ClassName n, predType = t }], qualType = t' }
  
  openRow :: Int -> Type
  openRow tv = Fix $ TRow Nothing $ TRowEnd $ Just $ RowTVar (Flex tv)
  
  prop :: String -> TScheme t -> TRowList t -> TRowList t
  prop name = TRowProp (TPropGetName $ EPropName name)
  
  addProp :: VarNames t => TRowList t -> (String, TScheme t) -> Infer (TRowList t)
  addProp rowlist (name, propTS) =
    do allocNames <- forM (schemeVars propTS) $ \tvName -> (tvName,) . Flex <$> fresh
       let ts' = mapVarNames (safeLookup allocNames) propTS
       return $ TRowProp (TPropGetName $ EPropName name) ts' rowlist
  