content: {-# LANGUAGE MultiParamTypeClasses, GADTs, FlexibleInstances #-}
  module GhcShim.API (
      -- * Traversing the AST
      IsBinder(..)
    , AstAlg(..)
    , Fold(..)
    , FoldPhase(..)
    ) where
  
  import Type   (Type)
  import SrcLoc (SrcSpan, Located)
  import Name   (Name)
  import Var    (Var)
  
  -- | Is this a binding occurrence of @f@?
  data IsBinder =
      DefSite   -- ^ @f = ..@
    | UseSite   -- ^ @g = f ..@
    | SigSite   -- ^ @f :: ..@ or fixity declaration
  
  -- | The "algebra" that we use while traversing the AST.
  --
  -- This is not a general purpose fold; we look for identifiers and types.
  data AstAlg m id = AstAlg {
      -- | Mark a branch point in the AST
      astMark :: Maybe SrcSpan -> String -> m (Maybe Type) -> m (Maybe Type)
      -- | Throw a runtime error
    , astUnsupported :: Maybe SrcSpan -> String -> m (Maybe Type)
      -- | Found a subexpression type
    , astExpType :: SrcSpan -> Maybe Type -> m (Maybe Type)
      -- | Found a 'Name' (i.e., pre type checking)
    , astId :: IsBinder -> Located id -> m (Maybe Type)
      -- | Are we running pre or post type checking?
    , astPhase :: FoldPhase id
    }
  
  class Fold id a where
    fold :: Monad m => AstAlg m id -> a -> m (Maybe Type)
  
  data FoldPhase id where
    FoldPreTc  :: FoldPhase Name
    FoldPostTc :: FoldPhase Var
  
  instance Fold id a => Fold id [a] where
    fold alg xs = do
      mapM_ (fold alg) xs
      return Nothing
  
  instance Fold id a => Fold id (Maybe a) where
    fold _alg Nothing  = return Nothing
    fold  alg (Just x) = fold alg x
  