table.hs

data Separator = Dot | Quest | App

data Access t
  = Access Separator (Access t) (Access t)
  | Term (t Name)
  | Base Name

desugar :: (Monad m, Carrier sig t, Member Core sig) => Access t -> m (t Name)
desugar t = case t of
  Access Dot a b   -> (Core....) <$> desugar a <*> ensureName b
  Access Quest a b -> (Core..?)  <$> desugar a <*> ensureName b
  Access App a b   -> (Core.$$)  <$> desugar a <*> desugar b

  Term t -> pure t
  Base t -> pure . pure $ t
  where
    ensureName (Base t) = pure t
    ensureName _other   = fail ("Couldn't desugar access")


application :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t Name)
application = Expr.buildExpressionParser table term >>= desugar
  where
    table = [ [ Expr.Infix (Access Quest <$ symbol ".?") Expr.AssocLeft
              , Expr.Infix (Access Dot   <$ symbol ".")  Expr.AssocLeft
              ]
            , [ Expr.Infix (Access App <$ notFollowedBy dot) Expr.AssocLeft
              ]
            ]
    term = choice [ Term <$> comp
                  , Term <$> lit
                  , Base <$> ident
                  , Term <$> parens expr
                  ]